Mercurial > octave

annotate liboctave/numeric/lo-specfun.cc @ 20156:bd565f3e0ecb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
psi: refactor to reduce code duplication. * liboctave/numeric/lo-specfun.cc (psi): reduce code duplication by creating Lanczos_approximation_psi() to be shared between the functions for complex and real input. Also invert the order of the for loops (to sum smaller numbers first, which will increase accuracy. * libinterp/corefcn/psi.cc: adjust tolerance for the tests.
author Carnë Draug <carandraug@octave.org>
date Sun, 03 May 2015 02:59:28 +0100
parents 1fae49e34a1a
children 65e22ba879f0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1 /*
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
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
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
8
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
9 This file is part of Octave.
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
10
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
11 Octave is free software; you can redistribute it and/or modify it
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
12 under the terms of the GNU General Public License as published by the
7016
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 6969
diff changeset
13 Free Software Foundation; either version 3 of the License, or (at your
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 6969
diff changeset
14 option) any later version.
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
15
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
16 Octave is distributed in the hope that it will be useful, but WITHOUT
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
18 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
19 for more details.
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
20
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
21 You should have received a copy of the GNU General Public License
7016
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 6969
diff changeset
22 along with Octave; see the file COPYING. If not, see
93c65f2a5668 [project @ 2007-10-12 06:40:56 by jwe]
jwe
parents: 6969
diff changeset
23 <http://www.gnu.org/licenses/>.
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
24
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
25 */
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
26
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
27 #ifdef HAVE_CONFIG_H
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
28 #include <config.h>
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
29 #endif
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
30
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
31 #include "Range.h"
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
32 #include "CColVector.h"
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
33 #include "CMatrix.h"
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
34 #include "dRowVector.h"
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
35 #include "dMatrix.h"
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
36 #include "dNDArray.h"
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
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
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
44 #include "f77-fcn.h"
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
45 #include "lo-error.h"
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
46 #include "lo-ieee.h"
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
47 #include "lo-specfun.h"
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
48 #include "mx-inlines.cc"
5701
252b6754e545 [project @ 2006-03-21 18:15:42 by jwe]
jwe
parents: 5700
diff changeset
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
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
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
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
54 extern "C"
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
55 {
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
56 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
57 F77_FUNC (zbesj, ZBESJ) (const double&, const double&, const double&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
58 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
59 double*, double*, octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
60 octave_idx_type&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
61
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
62 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
63 F77_FUNC (zbesy, ZBESY) (const double&, const double&, const double&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
64 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
65 double*, double*, octave_idx_type&, double*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
66 double*, octave_idx_type&);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
67
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
68 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
69 F77_FUNC (zbesi, ZBESI) (const double&, const double&, const double&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
70 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
71 double*, double*, octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
72 octave_idx_type&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
73
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
74 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
75 F77_FUNC (zbesk, ZBESK) (const double&, const double&, const double&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
76 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
77 double*, double*, octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
78 octave_idx_type&);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
79
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
80 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
81 F77_FUNC (zbesh, ZBESH) (const double&, const double&, const double&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
82 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
83 const octave_idx_type&, double*, double*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
84 octave_idx_type&, octave_idx_type&);
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
85
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
86 F77_RET_T
8279
b3734f1cb592 lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents: 8278
diff changeset
87 F77_FUNC (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
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
114 F77_FUNC (zairy, ZAIRY) (const double&, const double&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
115 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
116 double&, double&, octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
117 octave_idx_type&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
118
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
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
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
121 const octave_idx_type&, float&, float&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
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
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
125 F77_FUNC (zbiry, ZBIRY) (const double&, const double&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
126 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
127 double&, double&, octave_idx_type&);
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
128
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
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
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
131 const octave_idx_type&, float&, float&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
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
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
135 F77_FUNC (xdacosh, XDACOSH) (const double&, double&);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
136
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
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
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
141 F77_FUNC (xdasinh, XDASINH) (const double&, double&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
142
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
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
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
147 F77_FUNC (xdatanh, XDATANH) (const double&, double&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
148
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
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
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
153 F77_FUNC (xderf, XDERF) (const double&, double&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
154
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
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
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
159 F77_FUNC (xderfc, XDERFC) (const double&, double&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
160
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
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
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
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
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
167
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
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
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
173 F77_FUNC (xdgamma, XDGAMMA) (const double&, double&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
174
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
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
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
179 F77_FUNC (xgammainc, XGAMMAINC) (const double&, const double&, double&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
180
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
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
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
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&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
189 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
190
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
191 #if !defined (HAVE_ACOSH)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
192 double
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
193 acosh (double x)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
194 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
195 double retval;
5278
fe23ec6763b7 [project @ 2005-04-12 21:04:39 by jwe]
jwe
parents: 5275
diff changeset
196 F77_XFCN (xdacosh, XDACOSH, (x, retval));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
197 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
198 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
199 #endif
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
200
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
201 #if !defined (HAVE_ACOSHF)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
202 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
203 acoshf (float x)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
204 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
205 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
206 F77_XFCN (xacosh, XACOSH, (x, retval));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
207 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
208 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
209 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
210
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
211 #if !defined (HAVE_ASINH)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
212 double
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
213 asinh (double x)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
214 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
215 double retval;
5278
fe23ec6763b7 [project @ 2005-04-12 21:04:39 by jwe]
jwe
parents: 5275
diff changeset
216 F77_XFCN (xdasinh, XDASINH, (x, retval));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
217 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
218 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
219 #endif
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
220
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
221 #if !defined (HAVE_ASINHF)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
222 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
223 asinhf (float x)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
224 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
225 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
226 F77_XFCN (xasinh, XASINH, (x, retval));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
227 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
228 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
229 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
230
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
231 #if !defined (HAVE_ATANH)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
232 double
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
233 atanh (double x)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
234 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
235 double retval;
5278
fe23ec6763b7 [project @ 2005-04-12 21:04:39 by jwe]
jwe
parents: 5275
diff changeset
236 F77_XFCN (xdatanh, XDATANH, (x, retval));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
237 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
238 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
239 #endif
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
240
7914
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
241 #if !defined (HAVE_ATANHF)
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
242 float
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
243 atanhf (float x)
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
244 {
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
245 float retval;
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
246 F77_XFCN (xatanh, XATANH, (x, retval));
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
247 return retval;
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
248 }
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
249 #endif
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
250
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
251 #if !defined (HAVE_ERF)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
252 double
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
253 erf (double x)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
254 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
255 double retval;
5278
fe23ec6763b7 [project @ 2005-04-12 21:04:39 by jwe]
jwe
parents: 5275
diff changeset
256 F77_XFCN (xderf, XDERF, (x, retval));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
257 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
258 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
259 #endif
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
260
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
261 #if !defined (HAVE_ERFF)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
262 float
7914
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
263 erff (float x)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
264 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
265 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
266 F77_XFCN (xerf, XERF, (x, retval));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
267 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
268 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
269 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
270
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
271 #if !defined (HAVE_ERFC)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
272 double
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
273 erfc (double x)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
274 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
275 double retval;
5278
fe23ec6763b7 [project @ 2005-04-12 21:04:39 by jwe]
jwe
parents: 5275
diff changeset
276 F77_XFCN (xderfc, XDERFC, (x, retval));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
277 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
278 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
279 #endif
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
280
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
281 #if !defined (HAVE_ERFCF)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
282 float
7914
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
283 erfcf (float x)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
284 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
285 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
286 F77_XFCN (xerfc, XERFC, (x, retval));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
287 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
288 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
289 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
290
15696
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
291 // 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
292 Complex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
293 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
294 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
295 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
296 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
297 FloatComplex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
298 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
299 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
300 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
301 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
302 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
303 }
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 // 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
306 Complex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
307 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
308 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
309 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
310 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
311 FloatComplex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
312 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
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 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
315 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
316 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
317 }
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 // 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
320 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
321 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
322 Complex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
323 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
324 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
325 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
326 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
327 FloatComplex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
328 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
329 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
330 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
331 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
332 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
333 }
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 // 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
336 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
337 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
338 Complex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
339 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
340 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
341 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
342 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
343 FloatComplex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
344 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
345 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
346 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
347 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
348 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
349 }
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 // 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
352 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
353 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
354 Complex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
355 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
356 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
357 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
358 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
359 FloatComplex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
360 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
361 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
362 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
363 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
364 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
365 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
366
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
367 double
3156
a494f93e60ff [project @ 1998-02-20 07:47:48 by jwe]
jwe
parents: 3146
diff changeset
368 xgamma (double x)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
369 {
3156
a494f93e60ff [project @ 1998-02-20 07:47:48 by jwe]
jwe
parents: 3146
diff changeset
370 double result;
5701
252b6754e545 [project @ 2006-03-21 18:15:42 by jwe]
jwe
parents: 5700
diff changeset
371
19357
c6437824681c improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents: 17769
diff changeset
372 // 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
373 // 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
374
c6437824681c improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents: 17769
diff changeset
375 if (x == 0)
c6437824681c improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents: 17769
diff changeset
376 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
377 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
378 result = octave_Inf;
c6437824681c improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents: 17769
diff changeset
379 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
380 result = octave_NaN;
5701
252b6754e545 [project @ 2006-03-21 18:15:42 by jwe]
jwe
parents: 5700
diff changeset
381 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
382 {
11327
ef0e995f8c0f correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents: 10902
diff changeset
383 #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
384 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
385 #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
386 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
387 #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
388 }
6969
0a64abe792f4 [project @ 2007-10-06 14:15:19 by jwe]
jwe
parents: 6961
diff changeset
389
3156
a494f93e60ff [project @ 1998-02-20 07:47:48 by jwe]
jwe
parents: 3146
diff changeset
390 return result;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
391 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
392
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
393 double
3156
a494f93e60ff [project @ 1998-02-20 07:47:48 by jwe]
jwe
parents: 3146
diff changeset
394 xlgamma (double x)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
395 {
6969
0a64abe792f4 [project @ 2007-10-06 14:15:19 by jwe]
jwe
parents: 6961
diff changeset
396 #if defined (HAVE_LGAMMA)
0a64abe792f4 [project @ 2007-10-06 14:15:19 by jwe]
jwe
parents: 6961
diff changeset
397 return lgamma (x);
0a64abe792f4 [project @ 2007-10-06 14:15:19 by jwe]
jwe
parents: 6961
diff changeset
398 #else
3156
a494f93e60ff [project @ 1998-02-20 07:47:48 by jwe]
jwe
parents: 3146
diff changeset
399 double result;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
400 double sgngam;
4497
2a02f3a16fe0 [project @ 2003-09-04 18:48:13 by jwe]
jwe
parents: 4490
diff changeset
401
5701
252b6754e545 [project @ 2006-03-21 18:15:42 by jwe]
jwe
parents: 5700
diff changeset
402 if (xisnan (x))
252b6754e545 [project @ 2006-03-21 18:15:42 by jwe]
jwe
parents: 5700
diff changeset
403 result = x;
10902
9a64e02e2aad Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents: 10521
diff changeset
404 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x))
5701
252b6754e545 [project @ 2006-03-21 18:15:42 by jwe]
jwe
parents: 5700
diff changeset
405 result = octave_Inf;
5700
67118c88cee7 [project @ 2006-03-21 17:31:45 by jwe]
jwe
parents: 5307
diff changeset
406 else
67118c88cee7 [project @ 2006-03-21 17:31:45 by jwe]
jwe
parents: 5307
diff changeset
407 F77_XFCN (dlgams, DLGAMS, (x, result, sgngam));
4497
2a02f3a16fe0 [project @ 2003-09-04 18:48:13 by jwe]
jwe
parents: 4490
diff changeset
408
3156
a494f93e60ff [project @ 1998-02-20 07:47:48 by jwe]
jwe
parents: 3146
diff changeset
409 return result;
6969
0a64abe792f4 [project @ 2007-10-06 14:15:19 by jwe]
jwe
parents: 6961
diff changeset
410 #endif
6961
b559b4bcf51f [project @ 2007-10-05 19:35:21 by jwe]
jwe
parents: 5775
diff changeset
411 }
b559b4bcf51f [project @ 2007-10-05 19:35:21 by jwe]
jwe
parents: 5775
diff changeset
412
7601
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
413 Complex
9812
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
414 rc_lgamma (double x)
7601
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
415 {
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
416 double result;
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
417
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
418 #if defined (HAVE_LGAMMA_R)
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
419 int sgngam;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
420 result = lgamma_r (x, &sgngam);
7601
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
421 #else
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
422 double sgngam;
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
423
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
424 if (xisnan (x))
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
425 result = x;
10902
9a64e02e2aad Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents: 10521
diff changeset
426 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
427 result = octave_Inf;
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
428 else
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
429 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
430
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
431 #endif
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
432
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
433 if (sgngam < 0)
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
434 return result + Complex (0., M_PI);
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
435 else
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
436 return result;
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
437 }
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
438
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
439 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
440 xgamma (float x)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
441 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
442 float result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
443
19357
c6437824681c improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents: 17769
diff changeset
444 // 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
445 // 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
446
c6437824681c improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents: 17769
diff changeset
447 if (x == 0)
c6437824681c improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents: 17769
diff changeset
448 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
449 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
450 result = octave_Float_Inf;
c6437824681c improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents: 17769
diff changeset
451 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
452 result = octave_Float_NaN;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
453 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
454 {
f10b7a578e2c Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents: 17502
diff changeset
455 #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
456 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
457 #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
458 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
459 #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
460 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
461
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
462 return result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
463 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
464
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
465 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
466 xlgamma (float x)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
467 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
468 #if defined (HAVE_LGAMMAF)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
469 return lgammaf (x);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
470 #else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
471 float result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
472 float sgngam;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
473
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
474 if (xisnan (x))
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
475 result = x;
10902
9a64e02e2aad Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents: 10521
diff changeset
476 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
477 result = octave_Float_Inf;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
478 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
479 F77_XFCN (algams, ALGAMS, (x, result, sgngam));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
480
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
481 return result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
482 #endif
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
485 FloatComplex
9812
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
486 rc_lgamma (float x)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
487 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
488 float result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
489
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
490 #if defined (HAVE_LGAMMAF_R)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
491 int sgngam;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
492 result = lgammaf_r (x, &sgngam);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
493 #else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
494 float sgngam;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
495
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
496 if (xisnan (x))
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
497 result = x;
10902
9a64e02e2aad Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents: 10521
diff changeset
498 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
499 result = octave_Float_Inf;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
500 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
501 F77_XFCN (algams, ALGAMS, (x, result, sgngam));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
502
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
503 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
504
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
505 if (sgngam < 0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
506 return result + FloatComplex (0., M_PI);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
507 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
508 return result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
509 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
510
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
511 #if !defined (HAVE_EXPM1)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
512 double
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
513 expm1 (double x)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
514 {
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
515 double retval;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
516
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
517 double ax = fabs (x);
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
518
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
519 if (ax < 0.1)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
520 {
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
521 ax /= 16;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
522
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
523 // use Taylor series to calculate exp(x)-1.
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
524 double t = ax;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
525 double s = 0;
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
526 for (int i = 2; i < 7; i++)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
527 s += (t *= ax/i);
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
528 s += ax;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
529
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
530 // use the identity (a+1)^2-1 = a*(a+2)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
531 double e = s;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
532 for (int i = 0; i < 4; i++)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
533 {
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
534 s *= e + 2;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
535 e *= e + 2;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
536 }
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
537
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
538 retval = (x > 0) ? s : -s / (1+s);
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 else
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
541 retval = exp (x) - 1;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
542
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
543 return retval;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
544 }
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
545 #endif
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
546
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
547 Complex
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14847
diff changeset
548 expm1 (const Complex& x)
7638
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 Complex retval;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
551
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
552 if (std:: abs (x) < 1)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
553 {
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
554 double im = x.imag ();
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
555 double u = expm1 (x.real ());
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
556 double v = sin (im/2);
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
557 v = -2*v*v;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
558 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
559 }
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
560 else
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
561 retval = std::exp (x) - Complex (1);
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
562
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
563 return retval;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
564 }
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
565
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
566 #if !defined (HAVE_EXPM1F)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
567 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
568 expm1f (float x)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
569 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
570 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
571
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
572 float ax = fabs (x);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
573
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
574 if (ax < 0.1)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
575 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
576 ax /= 16;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
577
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
578 // use Taylor series to calculate exp(x)-1.
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
579 float t = ax;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
580 float s = 0;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
581 for (int i = 2; i < 7; i++)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
582 s += (t *= ax/i);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
583 s += ax;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
584
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
585 // 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
586 float e = s;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
587 for (int i = 0; i < 4; i++)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
588 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
589 s *= e + 2;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
590 e *= e + 2;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
591 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
592
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
593 retval = (x > 0) ? s : -s / (1+s);
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 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
596 retval = exp (x) - 1;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
597
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
598 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
599 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
600 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
601
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
602 FloatComplex
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14847
diff changeset
603 expm1 (const FloatComplex& x)
7789
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 FloatComplex retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
606
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
607 if (std:: abs (x) < 1)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
608 {
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
609 float im = x.imag ();
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
610 float u = expm1 (x.real ());
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
611 float v = sin (im/2);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
612 v = -2*v*v;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
613 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
614 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
615 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
616 retval = std::exp (x) - FloatComplex (1);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
617
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
618 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
619 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
620
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
621 #if !defined (HAVE_LOG1P)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
622 double
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
623 log1p (double x)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
624 {
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
625 double retval;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
626
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
627 double ax = fabs (x);
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
628
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
629 if (ax < 0.2)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
630 {
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
631 // 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
632 double u = x / (2 + x), t = 1, s = 0;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
633 for (int i = 2; i < 12; i += 2)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
634 s += (t *= u*u) / (i+1);
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
635
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
636 retval = 2 * (s + 1) * u;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
637 }
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
638 else
19375
264ff6bf7475 use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents: 19358
diff changeset
639 retval = gnulib::log (1 + x);
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
640
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
641 return retval;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
642 }
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
643 #endif
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
644
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
645 Complex
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
646 log1p (const Complex& x)
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 Complex retval;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
649
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
650 double r = x.real (), i = x.imag ();
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
651
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
652 if (fabs (r) < 0.5 && fabs (i) < 0.5)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
653 {
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
654 double u = 2*r + r*r + i*i;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
655 retval = Complex (log1p (u / (1+sqrt (u+1))),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
656 atan2 (1 + r, i));
7638
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 else
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14847
diff changeset
659 retval = std::log (Complex (1) + x);
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
660
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
661 return retval;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
662 }
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
663
10414
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
664 #if !defined (HAVE_CBRT)
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
665 double cbrt (double x)
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
666 {
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
667 static const double one_third = 0.3333333333333333333;
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
668 if (xfinite (x))
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
669 {
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
670 // Use pow.
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
671 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
672 // Correct for better accuracy.
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
673 return (x / (y*y) + y + y) / 3;
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
674 }
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
675 else
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
676 return x;
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
677 }
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
678 #endif
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
679
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
680 #if !defined (HAVE_LOG1PF)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
681 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
682 log1pf (float x)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
683 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
684 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
685
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
686 float ax = fabs (x);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
687
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
688 if (ax < 0.2)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
689 {
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
690 // 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
691 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
692 for (int i = 2; i < 12; i += 2)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
693 s += (t *= u*u) / (i+1);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
694
19375
264ff6bf7475 use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents: 19358
diff changeset
695 retval = 2 * (s + 1.0f) * u;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
696 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
697 else
19375
264ff6bf7475 use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents: 19358
diff changeset
698 retval = gnulib::logf (1.0f + x);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
699
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
700 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
701 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
702 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
703
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
704 FloatComplex
9812
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
705 log1p (const FloatComplex& x)
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 FloatComplex retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
708
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
709 float r = x.real (), i = x.imag ();
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
710
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
711 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
712 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
713 float u = 2*r + r*r + i*i;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
714 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
715 atan2 (1 + r, i));
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 else
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14847
diff changeset
718 retval = std::log (FloatComplex (1) + x);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
719
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
720 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
721 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
722
10414
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
723 #if !defined (HAVE_CBRTF)
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
724 float cbrtf (float x)
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
725 {
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
726 static const float one_third = 0.3333333333333333333f;
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
727 if (xfinite (x))
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
728 {
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
729 // Use pow.
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
730 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
731 // Correct for better accuracy.
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
732 return (x / (y*y) + y + y) / 3;
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
733 }
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
734 else
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
735 return x;
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
736 }
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
737 #endif
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
738
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
739 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
740 zbesj (const Complex& z, double alpha, int kode, octave_idx_type& ierr);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
741
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
742 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
743 zbesy (const Complex& z, double alpha, int kode, octave_idx_type& ierr);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
744
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
745 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
746 zbesi (const Complex& z, double alpha, int kode, octave_idx_type& ierr);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
747
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
748 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
749 zbesk (const Complex& z, double alpha, int kode, octave_idx_type& ierr);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
750
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
751 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
752 zbesh1 (const Complex& z, double alpha, int kode, octave_idx_type& ierr);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
753
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
754 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
755 zbesh2 (const Complex& z, double alpha, int kode, octave_idx_type& ierr);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
756
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
757 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
758 bessel_return_value (const Complex& val, octave_idx_type ierr)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
759 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
760 static const Complex inf_val = Complex (octave_Inf, octave_Inf);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
761 static const Complex nan_val = Complex (octave_NaN, octave_NaN);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
762
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
763 Complex retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
764
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
765 switch (ierr)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
766 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
767 case 0:
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
768 case 3:
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
769 retval = val;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
770 break;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
771
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
772 case 2:
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
773 retval = inf_val;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
774 break;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
775
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
776 default:
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
777 retval = nan_val;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
778 break;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
779 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
780
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
781 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
782 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
783
4911
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
784 static inline bool
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
785 is_integer_value (double x)
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
786 {
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
787 return x == static_cast<double> (static_cast<long> (x));
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
788 }
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
789
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
790 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
791 zbesj (const Complex& z, double alpha, int kode, octave_idx_type& ierr)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
792 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
793 Complex retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
794
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
795 if (alpha >= 0.0)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
796 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
797 double yr = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
798 double yi = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
799
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
800 octave_idx_type nz;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
801
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
802 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
803 double zi = z.imag ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
804
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
805 F77_FUNC (zbesj, ZBESJ) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr);
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
806
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
807 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
808 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
809 double expz = exp (std::abs (zi));
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
810 yr *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
811 yi *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
812 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
813
4490
1aed172ab84a [project @ 2003-08-28 19:03:06 by jwe]
jwe
parents: 4180
diff changeset
814 if (zi == 0.0 && zr >= 0.0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
815 yi = 0.0;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
816
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
817 retval = bessel_return_value (Complex (yr, yi), ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
818 }
4911
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
819 else if (is_integer_value (alpha))
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
820 {
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
821 // zbesy can overflow as z->0, and cause troubles for generic case below
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
822 alpha = -alpha;
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
823 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
824 if ((static_cast<long> (alpha)) & 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
825 tmp = - tmp;
4911
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
826 retval = bessel_return_value (tmp, ierr);
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
827 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
828 else
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
829 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
830 alpha = -alpha;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
831
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
832 Complex tmp = cos (M_PI * alpha) * zbesj (z, alpha, kode, ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
833
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
834 if (ierr == 0 || ierr == 3)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
835 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
836 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
837
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
838 retval = bessel_return_value (tmp, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
839 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
840 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
841 retval = Complex (octave_NaN, octave_NaN);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
842 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
843
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
844 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
845 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
846
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
847 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
848 zbesy (const Complex& z, double alpha, int kode, octave_idx_type& ierr)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
849 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
850 Complex retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
851
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
852 if (alpha >= 0.0)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
853 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
854 double yr = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
855 double yi = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
856
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
857 octave_idx_type nz;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
858
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
859 double wr, wi;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
860
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
861 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
862 double zi = z.imag ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
863
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
864 ierr = 0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
865
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
866 if (zr == 0.0 && zi == 0.0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
867 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
868 yr = -octave_Inf;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
869 yi = 0.0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
870 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
871 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
872 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
873 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
874 &wr, &wi, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
875
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
876 if (kode != 2)
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 double expz = exp (std::abs (zi));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
879 yr *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
880 yi *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
881 }
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 if (zi == 0.0 && zr >= 0.0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
884 yi = 0.0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
885 }
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
886
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
887 return bessel_return_value (Complex (yr, yi), ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
888 }
4911
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
889 else if (is_integer_value (alpha - 0.5))
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
890 {
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
891 // zbesy can overflow as z->0, and cause troubles for generic case below
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
892 alpha = -alpha;
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
893 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
894 if ((static_cast<long> (alpha - 0.5)) & 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
895 tmp = - tmp;
4911
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
896 retval = bessel_return_value (tmp, ierr);
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
897 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
898 else
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
899 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
900 alpha = -alpha;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
901
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
902 Complex tmp = cos (M_PI * alpha) * zbesy (z, alpha, kode, ierr);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
903
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
904 if (ierr == 0 || ierr == 3)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
905 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
906 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
907
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
908 retval = bessel_return_value (tmp, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
909 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
910 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
911 retval = Complex (octave_NaN, octave_NaN);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
912 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
913
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
914 return retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
915 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
916
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
917 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
918 zbesi (const Complex& z, double alpha, int kode, octave_idx_type& ierr)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
919 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
920 Complex retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
921
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
922 if (alpha >= 0.0)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
923 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
924 double yr = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
925 double yi = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
926
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
927 octave_idx_type nz;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
928
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
929 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
930 double zi = z.imag ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
931
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
932 F77_FUNC (zbesi, ZBESI) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr);
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
933
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
934 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
935 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
936 double expz = exp (std::abs (zr));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
937 yr *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
938 yi *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
939 }
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
940
4490
1aed172ab84a [project @ 2003-08-28 19:03:06 by jwe]
jwe
parents: 4180
diff changeset
941 if (zi == 0.0 && zr >= 0.0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
942 yi = 0.0;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
943
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
944 retval = bessel_return_value (Complex (yr, yi), ierr);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
945 }
14196
35ce1eab7400 besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents: 14138
diff changeset
946 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
947 {
35ce1eab7400 besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents: 14138
diff changeset
948 // 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
949 alpha = -alpha;
35ce1eab7400 besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents: 14138
diff changeset
950 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
951 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
952 }
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
953 else
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
954 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
955 alpha = -alpha;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
956
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
957 Complex tmp = zbesi (z, alpha, kode, ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
958
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
959 if (ierr == 0 || ierr == 3)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
960 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
961 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
962 * zbesk (z, alpha, kode, ierr);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
963
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
964 if (kode == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
965 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
966 // 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
967 tmp2 *= exp (-z - std::abs (z.real ()));
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
968 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
969
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
970 tmp += tmp2;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
971
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
972 retval = bessel_return_value (tmp, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
973 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
974 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
975 retval = Complex (octave_NaN, octave_NaN);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
976 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
977
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
978 return retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
979 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
980
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
981 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
982 zbesk (const Complex& z, double alpha, int kode, octave_idx_type& ierr)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
983 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
984 Complex retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
985
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
986 if (alpha >= 0.0)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
987 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
988 double yr = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
989 double yi = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
990
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
991 octave_idx_type nz;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
992
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
993 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
994 double zi = z.imag ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
995
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
996 ierr = 0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
997
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
998 if (zr == 0.0 && zi == 0.0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
999 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1000 yr = octave_Inf;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1001 yi = 0.0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1002 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1003 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1004 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1005 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
1006
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1007 if (kode != 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1008 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1009 Complex expz = exp (-z);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1010
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1011 double rexpz = real (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1012 double iexpz = imag (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1013
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1014 double tmp = yr*rexpz - yi*iexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1015
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1016 yi = yr*iexpz + yi*rexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1017 yr = tmp;
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
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1020 if (zi == 0.0 && zr >= 0.0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1021 yi = 0.0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1022 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1023
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1024 retval = bessel_return_value (Complex (yr, yi), ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1025 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1026 else
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1027 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1028 Complex tmp = zbesk (z, -alpha, kode, ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1029
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1030 retval = bessel_return_value (tmp, ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1031 }
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1032
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1033 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1034 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1035
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1036 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1037 zbesh1 (const Complex& z, double alpha, int kode, octave_idx_type& ierr)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1038 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1039 Complex retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1040
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1041 if (alpha >= 0.0)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1042 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1043 double yr = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1044 double yi = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1045
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1046 octave_idx_type nz;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1047
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1048 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1049 double zi = z.imag ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1050
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1051 F77_FUNC (zbesh, ZBESH) (zr, zi, alpha, 2, 1, 1, &yr, &yi, nz, ierr);
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1052
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1053 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1054 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1055 Complex expz = exp (Complex (0.0, 1.0) * z);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1056
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1057 double rexpz = real (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1058 double iexpz = imag (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1059
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1060 double tmp = yr*rexpz - yi*iexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1061
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1062 yi = yr*iexpz + yi*rexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1063 yr = tmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1064 }
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1065
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1066 retval = bessel_return_value (Complex (yr, yi), ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1067 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1068 else
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1069 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1070 alpha = -alpha;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1071
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1072 static const Complex eye = Complex (0.0, 1.0);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1073
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1074 Complex tmp = exp (M_PI * alpha * eye) * zbesh1 (z, alpha, kode, ierr);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1075
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1076 retval = bessel_return_value (tmp, ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1077 }
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1078
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1079 return retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1080 }
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1081
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1082 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1083 zbesh2 (const Complex& z, double alpha, int kode, octave_idx_type& ierr)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1084 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1085 Complex retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1086
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1087 if (alpha >= 0.0)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1088 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1089 double yr = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1090 double yi = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1091
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1092 octave_idx_type nz;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1093
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1094 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1095 double zi = z.imag ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1096
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1097 F77_FUNC (zbesh, ZBESH) (zr, zi, alpha, 2, 2, 1, &yr, &yi, nz, ierr);
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1098
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1099 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1100 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1101 Complex expz = exp (-Complex (0.0, 1.0) * z);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1102
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1103 double rexpz = real (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1104 double iexpz = imag (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1105
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1106 double tmp = yr*rexpz - yi*iexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1107
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1108 yi = yr*iexpz + yi*rexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1109 yr = tmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1110 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1111
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1112 retval = bessel_return_value (Complex (yr, yi), ierr);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1113 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1114 else
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1115 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1116 alpha = -alpha;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1117
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1118 static const Complex eye = Complex (0.0, 1.0);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1119
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1120 Complex tmp = exp (-M_PI * alpha * eye) * zbesh2 (z, alpha, kode, ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1121
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1122 retval = bessel_return_value (tmp, ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1123 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1124
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1125 return retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1126 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1127
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1128 typedef Complex (*dptr) (const Complex&, double, int, octave_idx_type&);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1129
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1130 static inline Complex
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1131 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
1132 bool scaled, octave_idx_type& ierr)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1133 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1134 Complex retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1135
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1136 retval = f (x, alpha, (scaled ? 2 : 1), ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1137
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1138 return retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1139 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1140
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1141 static inline ComplexMatrix
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1142 do_bessel (dptr f, const char *, double alpha, const ComplexMatrix& x,
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1143 bool scaled, Array<octave_idx_type>& ierr)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1144 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1145 octave_idx_type nr = x.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1146 octave_idx_type nc = x.cols ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1147
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1148 ComplexMatrix retval (nr, nc);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1149
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1150 ierr.resize (dim_vector (nr, nc));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1151
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1152 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1153 for (octave_idx_type i = 0; i < nr; i++)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1154 retval(i,j) = f (x(i,j), alpha, (scaled ? 2 : 1), ierr(i,j));
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1155
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1156 return retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1157 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1158
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1159 static inline ComplexMatrix
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1160 do_bessel (dptr f, const char *, const Matrix& alpha, const Complex& x,
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1161 bool scaled, Array<octave_idx_type>& ierr)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1162 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1163 octave_idx_type nr = alpha.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1164 octave_idx_type nc = alpha.cols ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1165
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1166 ComplexMatrix retval (nr, nc);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1167
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1168 ierr.resize (dim_vector (nr, nc));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1169
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1170 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1171 for (octave_idx_type i = 0; i < nr; i++)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1172 retval(i,j) = f (x, alpha(i,j), (scaled ? 2 : 1), ierr(i,j));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1173
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1174 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1175 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1176
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1177 static inline ComplexMatrix
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1178 do_bessel (dptr f, const char *fn, const Matrix& alpha,
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1179 const ComplexMatrix& x, bool scaled, Array<octave_idx_type>& ierr)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1180 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1181 ComplexMatrix retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1182
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1183 octave_idx_type x_nr = x.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1184 octave_idx_type x_nc = x.cols ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1185
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1186 octave_idx_type alpha_nr = alpha.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1187 octave_idx_type alpha_nc = alpha.cols ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1188
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1189 if (x_nr == alpha_nr && x_nc == alpha_nc)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1190 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1191 octave_idx_type nr = x_nr;
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1192 octave_idx_type nc = x_nc;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1193
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1194 retval.resize (nr, nc);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1195
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1196 ierr.resize (dim_vector (nr, nc));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1197
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1198 for (octave_idx_type j = 0; j < nc; j++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1199 for (octave_idx_type i = 0; i < nr; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1200 retval(i,j) = f (x(i,j), alpha(i,j), (scaled ? 2 : 1), ierr(i,j));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1201 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1202 else
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1203 (*current_liboctave_error_handler)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1204 ("%s: the sizes of alpha and x must conform", fn);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1205
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1206 return retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1207 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1208
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1209 static inline ComplexNDArray
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1210 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
1211 bool scaled, Array<octave_idx_type>& ierr)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1212 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1213 dim_vector dv = x.dims ();
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1214 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1215 ComplexNDArray retval (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1216
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1217 ierr.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1218
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1219 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
1220 retval(i) = f (x(i), alpha, (scaled ? 2 : 1), ierr(i));
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1221
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1222 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1223 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1224
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1225 static inline ComplexNDArray
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1226 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
1227 bool scaled, Array<octave_idx_type>& ierr)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1228 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1229 dim_vector dv = alpha.dims ();
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1230 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1231 ComplexNDArray retval (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1232
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1233 ierr.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1234
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1235 for (octave_idx_type i = 0; i < nel; i++)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1236 retval(i) = f (x, alpha(i), (scaled ? 2 : 1), ierr(i));
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1237
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1238 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1239 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1240
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1241 static inline ComplexNDArray
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1242 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
1243 const ComplexNDArray& x, bool scaled, Array<octave_idx_type>& ierr)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1244 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1245 dim_vector dv = x.dims ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1246 ComplexNDArray retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1247
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1248 if (dv == alpha.dims ())
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1249 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1250 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1251
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1252 retval.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1253 ierr.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1254
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1255 for (octave_idx_type i = 0; i < nel; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1256 retval(i) = f (x(i), alpha(i), (scaled ? 2 : 1), ierr(i));
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1257 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1258 else
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1259 (*current_liboctave_error_handler)
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1260 ("%s: the sizes of alpha and x must conform", fn);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1261
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1262 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1263 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1264
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1265 static inline ComplexMatrix
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1266 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
1267 const ComplexColumnVector& x, bool scaled,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1268 Array<octave_idx_type>& ierr)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1269 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1270 octave_idx_type nr = x.length ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1271 octave_idx_type nc = alpha.length ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1272
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1273 ComplexMatrix retval (nr, nc);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1274
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1275 ierr.resize (dim_vector (nr, nc));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1276
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1277 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1278 for (octave_idx_type i = 0; i < nr; i++)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1279 retval(i,j) = f (x(i), alpha(j), (scaled ? 2 : 1), ierr(i,j));
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1280
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1281 return retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1282 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1283
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1284 #define SS_BESSEL(name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1285 Complex \
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1286 name (double alpha, const Complex& x, bool scaled, octave_idx_type& ierr) \
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1287 { \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1288 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1289 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1290
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1291 #define SM_BESSEL(name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1292 ComplexMatrix \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1293 name (double alpha, const ComplexMatrix& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1294 Array<octave_idx_type>& ierr) \
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1295 { \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1296 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1297 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1298
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1299 #define MS_BESSEL(name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1300 ComplexMatrix \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1301 name (const Matrix& alpha, const Complex& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1302 Array<octave_idx_type>& ierr) \
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1303 { \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1304 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1305 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1306
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1307 #define MM_BESSEL(name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1308 ComplexMatrix \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1309 name (const Matrix& alpha, const ComplexMatrix& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1310 Array<octave_idx_type>& ierr) \
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1311 { \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1312 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1313 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1314
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1315 #define SN_BESSEL(name, fcn) \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1316 ComplexNDArray \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1317 name (double alpha, const ComplexNDArray& x, bool scaled, \
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1318 Array<octave_idx_type>& ierr) \
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1319 { \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1320 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1321 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1322
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1323 #define NS_BESSEL(name, fcn) \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1324 ComplexNDArray \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1325 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
1326 Array<octave_idx_type>& ierr) \
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1327 { \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1328 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1329 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1330
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1331 #define NN_BESSEL(name, fcn) \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1332 ComplexNDArray \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1333 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
1334 Array<octave_idx_type>& ierr) \
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1335 { \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1336 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1337 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1338
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1339 #define RC_BESSEL(name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1340 ComplexMatrix \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1341 name (const RowVector& alpha, const ComplexColumnVector& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1342 Array<octave_idx_type>& ierr) \
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1343 { \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1344 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1345 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1346
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1347 #define ALL_BESSEL(name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1348 SS_BESSEL (name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1349 SM_BESSEL (name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1350 MS_BESSEL (name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1351 MM_BESSEL (name, fcn) \
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1352 SN_BESSEL (name, fcn) \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1353 NS_BESSEL (name, fcn) \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1354 NN_BESSEL (name, fcn) \
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1355 RC_BESSEL (name, fcn)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1356
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1357 ALL_BESSEL (besselj, zbesj)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1358 ALL_BESSEL (bessely, zbesy)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1359 ALL_BESSEL (besseli, zbesi)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1360 ALL_BESSEL (besselk, zbesk)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1361 ALL_BESSEL (besselh1, zbesh1)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1362 ALL_BESSEL (besselh2, zbesh2)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1363
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1364 #undef ALL_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1365 #undef SS_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1366 #undef SM_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1367 #undef MS_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1368 #undef MM_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1369 #undef SN_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1370 #undef NS_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1371 #undef NN_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1372 #undef RC_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1373
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1374 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1375 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
1376
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1377 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1378 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
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 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
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 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
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 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
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 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
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 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
1394 {
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1395 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
1396 octave_Float_Inf);
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1397 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
1398 octave_Float_NaN);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1399
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1400 FloatComplex retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1401
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1402 switch (ierr)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1403 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1404 case 0:
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1405 case 3:
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1406 retval = val;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1407 break;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1408
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1409 case 2:
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1410 retval = inf_val;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1411 break;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1412
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1413 default:
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1414 retval = nan_val;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1415 break;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1416 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1417
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1418 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1419 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1420
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1421 static inline bool
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1422 is_integer_value (float x)
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 x == static_cast<float> (static_cast<long> (x));
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 FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1428 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
1429 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1430 FloatComplex retval;
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 if (alpha >= 0.0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1433 {
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
1434 FloatComplex y = 0.0;
7789
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 octave_idx_type nz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1437
8279
b3734f1cb592 lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents: 8278
diff changeset
1438 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
1439
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1440 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1441 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1442 float expz = exp (std::abs (imag (z)));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1443 y *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1444 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1445
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
1446 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
1447 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
1448
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
1449 retval = bessel_return_value (y, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1450 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1451 else if (is_integer_value (alpha))
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1452 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1453 // 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
1454 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1455 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
1456 if ((static_cast<long> (alpha)) & 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1457 tmp = - tmp;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1458 retval = bessel_return_value (tmp, ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1459 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1460 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1461 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1462 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1463
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1464 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
1465 * cbesj (z, alpha, kode, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1466
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1467 if (ierr == 0 || ierr == 3)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1468 {
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1469 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
1470 * cbesy (z, alpha, kode, ierr);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1471
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1472 retval = bessel_return_value (tmp, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1473 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1474 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1475 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
1476 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1477
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1478 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1479 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1480
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1481 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1482 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
1483 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1484 FloatComplex 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 if (alpha >= 0.0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1487 {
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
1488 FloatComplex y = 0.0;
7789
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 octave_idx_type nz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1491
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
1492 FloatComplex w;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1493
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1494 ierr = 0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1495
8279
b3734f1cb592 lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents: 8278
diff changeset
1496 if (real (z) == 0.0 && imag (z) == 0.0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1497 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1498 y = FloatComplex (-octave_Float_Inf, 0.0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1499 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1500 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1501 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1502 F77_FUNC (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
1503
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1504 if (kode != 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1505 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1506 float expz = exp (std::abs (imag (z)));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1507 y *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1508 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1509
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1510 if (imag (z) == 0.0 && real (z) >= 0.0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1511 y = FloatComplex (y.real (), 0.0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1512 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1513
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
1514 return bessel_return_value (y, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1515 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1516 else if (is_integer_value (alpha - 0.5))
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1517 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1518 // 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
1519 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1520 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
1521 if ((static_cast<long> (alpha - 0.5)) & 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1522 tmp = - tmp;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1523 retval = bessel_return_value (tmp, ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1524 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1525 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1526 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1527 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1528
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1529 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
1530 * cbesy (z, alpha, kode, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1531
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1532 if (ierr == 0 || ierr == 3)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1533 {
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1534 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
1535 * cbesj (z, alpha, kode, ierr);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1536
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1537 retval = bessel_return_value (tmp, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1538 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1539 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1540 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
1541 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1542
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1543 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1544 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1545
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1546 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1547 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
1548 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1549 FloatComplex 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 if (alpha >= 0.0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1552 {
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
1553 FloatComplex y = 0.0;
7789
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 octave_idx_type nz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1556
8279
b3734f1cb592 lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents: 8278
diff changeset
1557 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
1558
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1559 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1560 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1561 float expz = exp (std::abs (real (z)));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1562 y *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1563 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1564
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
1565 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
1566 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
1567
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
1568 retval = bessel_return_value (y, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1569 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1570 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1571 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1572 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1573
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1574 FloatComplex tmp = cbesi (z, alpha, kode, ierr);
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 if (ierr == 0 || ierr == 3)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1577 {
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1578 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
1579 * 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
1580 * cbesk (z, alpha, kode, ierr);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
1581
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
1582 if (kode == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1583 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1584 // 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
1585 tmp2 *= exp (-z - std::abs (z.real ()));
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1586 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1587
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1588 tmp += tmp2;
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 retval = bessel_return_value (tmp, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1591 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1592 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1593 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
1594 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1595
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1596 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1597 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1598
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1599 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1600 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
1601 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1602 FloatComplex 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 if (alpha >= 0.0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1605 {
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
1606 FloatComplex y = 0.0;
7789
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 octave_idx_type nz;
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 ierr = 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 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
1613 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1614 y = FloatComplex (octave_Float_Inf, 0.0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1615 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1616 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1617 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1618 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
1619
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1620 if (kode != 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1621 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1622 FloatComplex expz = exp (-z);
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 float rexpz = real (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1625 float iexpz = imag (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1626
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1627 float tmp_r = real (y) * rexpz - imag (y) * iexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1628 float tmp_i = real (y) * iexpz + imag (y) * rexpz;
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 y = FloatComplex (tmp_r, tmp_i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1631 }
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 if (imag (z) == 0.0 && real (z) >= 0.0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1634 y = FloatComplex (y.real (), 0.0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1635 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1636
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
1637 retval = bessel_return_value (y, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1638 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1639 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1640 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1641 FloatComplex tmp = cbesk (z, -alpha, kode, ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1642
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1643 retval = bessel_return_value (tmp, ierr);
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1646 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1647 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1648
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1649 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1650 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
1651 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1652 FloatComplex 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 if (alpha >= 0.0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1655 {
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
1656 FloatComplex y = 0.0;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1657
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1658 octave_idx_type nz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1659
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
1660 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
1661
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1662 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1663 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1664 FloatComplex expz = exp (FloatComplex (0.0, 1.0) * z);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1665
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1666 float rexpz = real (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1667 float iexpz = imag (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1668
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1669 float tmp_r = real (y) * rexpz - imag (y) * iexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1670 float tmp_i = real (y) * iexpz + imag (y) * rexpz;
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 y = FloatComplex (tmp_r, tmp_i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1673 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1674
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
1675 retval = bessel_return_value (y, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1676 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1677 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1678 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1679 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1680
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1681 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
1682
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1683 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
1684 * cbesh1 (z, alpha, kode, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1685
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1686 retval = bessel_return_value (tmp, ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1687 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1688
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1689 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1690 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1691
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1692 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1693 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
1694 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1695 FloatComplex 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 if (alpha >= 0.0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1698 {
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
1699 FloatComplex y = 0.0;
7789
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 octave_idx_type nz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1702
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
1703 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
1704
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1705 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1706 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1707 FloatComplex expz = exp (-FloatComplex (0.0, 1.0) * z);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1708
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1709 float rexpz = real (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1710 float iexpz = imag (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1711
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1712 float tmp_r = real (y) * rexpz - imag (y) * iexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1713 float tmp_i = real (y) * iexpz + imag (y) * rexpz;
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 y = FloatComplex (tmp_r, tmp_i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1716 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1717
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
1718 retval = bessel_return_value (y, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1719 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1720 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1721 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1722 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1723
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1724 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
1725
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1726 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
1727 * cbesh2 (z, alpha, kode, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1728
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1729 retval = bessel_return_value (tmp, ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1730 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1731
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1732 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1733 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1734
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1735 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
1736 octave_idx_type&);
7789
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 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1739 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
1740 bool scaled, octave_idx_type& ierr)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1741 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1742 FloatComplex retval;
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 retval = f (x, alpha, (scaled ? 2 : 1), ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1745
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1746 return retval;
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1749 static inline FloatComplexMatrix
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1750 do_bessel (fptr f, const char *, float alpha, const FloatComplexMatrix& x,
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1751 bool scaled, Array<octave_idx_type>& ierr)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1752 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1753 octave_idx_type nr = x.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1754 octave_idx_type nc = x.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1755
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1756 FloatComplexMatrix retval (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1757
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1758 ierr.resize (dim_vector (nr, nc));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1759
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1760 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
1761 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
1762 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
1763
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1764 return retval;
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1767 static inline FloatComplexMatrix
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1768 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
1769 const FloatComplex& x,
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1770 bool scaled, Array<octave_idx_type>& ierr)
7789
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 octave_idx_type nr = alpha.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1773 octave_idx_type nc = alpha.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1774
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1775 FloatComplexMatrix retval (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1776
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1777 ierr.resize (dim_vector (nr, nc));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1778
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1779 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
1780 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
1781 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
1782
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1783 return retval;
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1786 static inline FloatComplexMatrix
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1787 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
1788 const FloatComplexMatrix& x, bool scaled,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1789 Array<octave_idx_type>& ierr)
7789
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 FloatComplexMatrix retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1792
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1793 octave_idx_type x_nr = x.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1794 octave_idx_type x_nc = x.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1795
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1796 octave_idx_type alpha_nr = alpha.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1797 octave_idx_type alpha_nc = alpha.cols ();
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 if (x_nr == alpha_nr && x_nc == alpha_nc)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1800 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1801 octave_idx_type nr = x_nr;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1802 octave_idx_type nc = x_nc;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1803
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1804 retval.resize (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1805
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1806 ierr.resize (dim_vector (nr, nc));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1807
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1808 for (octave_idx_type j = 0; j < nc; j++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1809 for (octave_idx_type i = 0; i < nr; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1810 retval(i,j) = f (x(i,j), alpha(i,j), (scaled ? 2 : 1), ierr(i,j));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1811 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1812 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1813 (*current_liboctave_error_handler)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1814 ("%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
1815
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1816 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1817 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1818
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1819 static inline FloatComplexNDArray
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1820 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
1821 bool scaled, Array<octave_idx_type>& ierr)
7789
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 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1824 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1825 FloatComplexNDArray retval (dv);
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 ierr.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1828
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1829 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
1830 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
1831
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1832 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1833 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1834
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1835 static inline FloatComplexNDArray
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1836 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
1837 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
1838 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1839 dim_vector dv = alpha.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1840 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1841 FloatComplexNDArray retval (dv);
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 ierr.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1844
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1845 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
1846 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
1847
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1848 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1849 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1850
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1851 static inline FloatComplexNDArray
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1852 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
1853 const FloatComplexNDArray& x, bool scaled,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1854 Array<octave_idx_type>& ierr)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1855 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1856 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1857 FloatComplexNDArray retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1858
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1859 if (dv == alpha.dims ())
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1860 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1861 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1862
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1863 retval.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1864 ierr.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1865
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1866 for (octave_idx_type i = 0; i < nel; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1867 retval(i) = f (x(i), alpha(i), (scaled ? 2 : 1), ierr(i));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1868 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1869 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1870 (*current_liboctave_error_handler)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1871 ("%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
1872
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1873 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1874 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1875
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1876 static inline FloatComplexMatrix
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1877 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
1878 const FloatComplexColumnVector& x, bool scaled,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1879 Array<octave_idx_type>& ierr)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1880 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1881 octave_idx_type nr = x.length ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1882 octave_idx_type nc = alpha.length ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1883
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1884 FloatComplexMatrix retval (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1885
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1886 ierr.resize (dim_vector (nr, nc));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1887
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1888 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
1889 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
1890 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
1891
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1892 return retval;
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1895 #define SS_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1896 FloatComplex \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1897 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
1898 { \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1899 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
1900 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1901
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1902 #define SM_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1903 FloatComplexMatrix \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1904 name (float alpha, const FloatComplexMatrix& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1905 Array<octave_idx_type>& ierr) \
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1906 { \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1907 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
1908 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1909
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1910 #define MS_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1911 FloatComplexMatrix \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1912 name (const FloatMatrix& alpha, const FloatComplex& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1913 Array<octave_idx_type>& ierr) \
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1914 { \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1915 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
1916 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1917
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1918 #define MM_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1919 FloatComplexMatrix \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1920 name (const FloatMatrix& alpha, const FloatComplexMatrix& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1921 Array<octave_idx_type>& ierr) \
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1922 { \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1923 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
1924 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1925
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1926 #define SN_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1927 FloatComplexNDArray \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1928 name (float alpha, const FloatComplexNDArray& x, bool scaled, \
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1929 Array<octave_idx_type>& ierr) \
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1930 { \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1931 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
1932 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1933
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1934 #define NS_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1935 FloatComplexNDArray \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1936 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
1937 Array<octave_idx_type>& ierr) \
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1938 { \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1939 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
1940 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1941
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1942 #define NN_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1943 FloatComplexNDArray \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1944 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
1945 Array<octave_idx_type>& ierr) \
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1946 { \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1947 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
1948 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1949
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1950 #define RC_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1951 FloatComplexMatrix \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1952 name (const FloatRowVector& alpha, const FloatComplexColumnVector& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1953 Array<octave_idx_type>& ierr) \
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1954 { \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1955 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
1956 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1957
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1958 #define ALL_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1959 SS_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1960 SM_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1961 MS_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1962 MM_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1963 SN_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1964 NS_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1965 NN_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1966 RC_BESSEL (name, fcn)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1967
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1968 ALL_BESSEL (besselj, cbesj)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1969 ALL_BESSEL (bessely, cbesy)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1970 ALL_BESSEL (besseli, cbesi)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1971 ALL_BESSEL (besselk, cbesk)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1972 ALL_BESSEL (besselh1, cbesh1)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1973 ALL_BESSEL (besselh2, cbesh2)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1974
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1975 #undef ALL_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1976 #undef SS_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1977 #undef SM_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1978 #undef MS_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1979 #undef MM_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1980 #undef SN_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1981 #undef NS_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1982 #undef NN_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1983 #undef RC_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1984
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1985 Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1986 airy (const Complex& z, bool deriv, bool scaled, octave_idx_type& ierr)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1987 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1988 double ar = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1989 double ai = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1990
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1991 octave_idx_type nz;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1992
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1993 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1994 double zi = z.imag ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1995
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1996 octave_idx_type id = deriv ? 1 : 0;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1997
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1998 F77_FUNC (zairy, ZAIRY) (zr, zi, id, 2, ar, ai, nz, ierr);
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1999
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2000 if (! scaled)
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2001 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14847
diff changeset
2002 Complex expz = exp (- 2.0 / 3.0 * z * sqrt (z));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2003
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2004 double rexpz = real (expz);
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2005 double iexpz = imag (expz);
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2006
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2007 double tmp = ar*rexpz - ai*iexpz;
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2008
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2009 ai = ar*iexpz + ai*rexpz;
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2010 ar = tmp;
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2011 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2012
4490
1aed172ab84a [project @ 2003-08-28 19:03:06 by jwe]
jwe
parents: 4180
diff changeset
2013 if (zi == 0.0 && (! scaled || zr >= 0.0))
3225
7aae2c3636a7 [project @ 1998-12-04 23:20:12 by jwe]
jwe
parents: 3220
diff changeset
2014 ai = 0.0;
7aae2c3636a7 [project @ 1998-12-04 23:20:12 by jwe]
jwe
parents: 3220
diff changeset
2015
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2016 return bessel_return_value (Complex (ar, ai), ierr);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2017 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2018
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2019 Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2020 biry (const Complex& z, bool deriv, bool scaled, octave_idx_type& ierr)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2021 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2022 double ar = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2023 double ai = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2024
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2025 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2026 double zi = z.imag ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2027
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2028 octave_idx_type id = deriv ? 1 : 0;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2029
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2030 F77_FUNC (zbiry, ZBIRY) (zr, zi, id, 2, ar, ai, ierr);
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2031
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2032 if (! scaled)
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2033 {
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2034 Complex expz = exp (std::abs (real (2.0 / 3.0 * z * sqrt (z))));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2035
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2036 double rexpz = real (expz);
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2037 double iexpz = imag (expz);
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2038
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2039 double tmp = ar*rexpz - ai*iexpz;
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2040
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2041 ai = ar*iexpz + ai*rexpz;
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2042 ar = tmp;
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2043 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2044
4490
1aed172ab84a [project @ 2003-08-28 19:03:06 by jwe]
jwe
parents: 4180
diff changeset
2045 if (zi == 0.0 && (! scaled || zr >= 0.0))
3225
7aae2c3636a7 [project @ 1998-12-04 23:20:12 by jwe]
jwe
parents: 3220
diff changeset
2046 ai = 0.0;
7aae2c3636a7 [project @ 1998-12-04 23:20:12 by jwe]
jwe
parents: 3220
diff changeset
2047
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2048 return bessel_return_value (Complex (ar, ai), ierr);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2049 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2050
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2051 ComplexMatrix
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2052 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
2053 Array<octave_idx_type>& ierr)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2054 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2055 octave_idx_type nr = z.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2056 octave_idx_type nc = z.cols ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2057
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2058 ComplexMatrix retval (nr, nc);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2059
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2060 ierr.resize (dim_vector (nr, nc));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2061
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2062 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2063 for (octave_idx_type i = 0; i < nr; i++)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2064 retval(i,j) = airy (z(i,j), deriv, scaled, ierr(i,j));
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2065
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2066 return retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2067 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2068
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2069 ComplexMatrix
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2070 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
2071 Array<octave_idx_type>& ierr)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2072 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2073 octave_idx_type nr = z.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2074 octave_idx_type nc = z.cols ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2075
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2076 ComplexMatrix retval (nr, nc);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2077
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2078 ierr.resize (dim_vector (nr, nc));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2079
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2080 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2081 for (octave_idx_type i = 0; i < nr; i++)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2082 retval(i,j) = biry (z(i,j), deriv, scaled, ierr(i,j));
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2083
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2084 return retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2085 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2086
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2087 ComplexNDArray
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2088 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
2089 Array<octave_idx_type>& ierr)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2090 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2091 dim_vector dv = z.dims ();
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2092 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2093 ComplexNDArray retval (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2094
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2095 ierr.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2096
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2097 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
2098 retval(i) = airy (z(i), deriv, scaled, ierr(i));
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2099
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2100 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2101 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2102
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2103 ComplexNDArray
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2104 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
2105 Array<octave_idx_type>& ierr)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2106 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2107 dim_vector dv = z.dims ();
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2108 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2109 ComplexNDArray retval (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2110
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2111 ierr.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2112
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2113 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
2114 retval(i) = biry (z(i), deriv, scaled, ierr(i));
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2115
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2116 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2117 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2118
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2119 FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2120 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
2121 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2122 float ar = 0.0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2123 float ai = 0.0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2124
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2125 octave_idx_type nz;
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 float zr = z.real ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2128 float zi = z.imag ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2129
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2130 octave_idx_type id = deriv ? 1 : 0;
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 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
2133
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2134 if (! scaled)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2135 {
19739
3fa35defe495 Adjust spacing of static_cast<> calls to follow Octave coding conventions.
Rik <rik@octave.org>
parents: 19697
diff changeset
2136 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
2137
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2138 float rexpz = real (expz);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2139 float iexpz = imag (expz);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2140
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2141 float tmp = ar*rexpz - ai*iexpz;
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 ai = ar*iexpz + ai*rexpz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2144 ar = tmp;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2145 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2146
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2147 if (zi == 0.0 && (! scaled || zr >= 0.0))
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2148 ai = 0.0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2149
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2150 return bessel_return_value (FloatComplex (ar, ai), ierr);
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2153 FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2154 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
2155 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2156 float ar = 0.0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2157 float ai = 0.0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2158
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2159 float zr = z.real ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2160 float zi = z.imag ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2161
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2162 octave_idx_type id = deriv ? 1 : 0;
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 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
2165
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2166 if (! scaled)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2167 {
19739
3fa35defe495 Adjust spacing of static_cast<> calls to follow Octave coding conventions.
Rik <rik@octave.org>
parents: 19697
diff changeset
2168 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
2169
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2170 float rexpz = real (expz);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2171 float iexpz = imag (expz);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2172
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2173 float tmp = ar*rexpz - ai*iexpz;
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 ai = ar*iexpz + ai*rexpz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2176 ar = tmp;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2177 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2178
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2179 if (zi == 0.0 && (! scaled || zr >= 0.0))
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2180 ai = 0.0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2181
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2182 return bessel_return_value (FloatComplex (ar, ai), ierr);
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2185 FloatComplexMatrix
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2186 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
2187 Array<octave_idx_type>& ierr)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2188 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2189 octave_idx_type nr = z.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2190 octave_idx_type nc = z.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2191
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2192 FloatComplexMatrix retval (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2193
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2194 ierr.resize (dim_vector (nr, nc));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2195
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2196 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
2197 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
2198 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
2199
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2200 return retval;
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2203 FloatComplexMatrix
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2204 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
2205 Array<octave_idx_type>& ierr)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2206 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2207 octave_idx_type nr = z.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2208 octave_idx_type nc = z.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2209
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2210 FloatComplexMatrix retval (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2211
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2212 ierr.resize (dim_vector (nr, nc));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2213
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2214 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
2215 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
2216 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
2217
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2218 return retval;
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2221 FloatComplexNDArray
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2222 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
2223 Array<octave_idx_type>& ierr)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2224 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2225 dim_vector dv = z.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2226 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2227 FloatComplexNDArray retval (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2228
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2229 ierr.resize (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 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
2232 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
2233
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2234 return retval;
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2237 FloatComplexNDArray
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2238 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
2239 Array<octave_idx_type>& ierr)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2240 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2241 dim_vector dv = z.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2242 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2243 FloatComplexNDArray retval (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2244
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2245 ierr.resize (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 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
2248 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
2249
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2250 return retval;
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
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2253 static void
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2254 gripe_betainc_nonconformant (const dim_vector& d1, const dim_vector& d2,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2255 const dim_vector& d3)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2256 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2257 std::string d1_str = d1.str ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2258 std::string d2_str = d2.str ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2259 std::string d3_str = d3.str ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2260
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2261 (*current_liboctave_error_handler)
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2262 ("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
2263 d1_str.c_str (), d2_str.c_str (), d3_str.c_str ());
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2264 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2265
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2266 static void
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2267 gripe_betaincinv_nonconformant (const dim_vector& d1, const dim_vector& d2,
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2268 const dim_vector& d3)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2269 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2270 std::string d1_str = d1.str ();
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2271 std::string d2_str = d2.str ();
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2272 std::string d3_str = d3.str ();
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2273
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2274 (*current_liboctave_error_handler)
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2275 ("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
2276 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
2277 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2278
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2279 double
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2280 betainc (double x, double a, double b)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2281 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2282 double retval;
5700
67118c88cee7 [project @ 2006-03-21 17:31:45 by jwe]
jwe
parents: 5307
diff changeset
2283 F77_XFCN (xdbetai, XDBETAI, (x, a, b, retval));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2284 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2285 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2286
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2287 Array<double>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2288 betainc (double x, double a, const Array<double>& b)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2289 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2290 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
2291 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
2292
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2293 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
2294
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2295 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
2296
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2297 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
2298 *pretval++ = betainc (x, a, b(i));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2299
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2300 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2301 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2302
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2303 Array<double>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2304 betainc (double x, const Array<double>& a, double b)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2305 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2306 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
2307 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
2308
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2309 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
2310
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2311 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
2312
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2313 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
2314 *pretval++ = betainc (x, a(i), b);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2315
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2316 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2317 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2318
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2319 Array<double>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2320 betainc (double x, const Array<double>& a, const Array<double>& b)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2321 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2322 Array<double> retval;
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2323 dim_vector dv = a.dims ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2324
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2325 if (dv == b.dims ())
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2326 {
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2327 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2328
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2329 retval.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2330
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2331 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
2332
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2333 for (octave_idx_type i = 0; i < nel; i++)
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2334 *pretval++ = betainc (x, a(i), b(i));
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2335 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2336 else
10258
e317791645c4 64-bit fixes
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2337 gripe_betainc_nonconformant (dim_vector (0, 0), dv, b.dims ());
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
2338
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2339 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2340 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
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
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
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
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2354
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2355 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2356 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
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
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
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
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2362 dim_vector dv = x.dims ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2363
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2364 if (dv == b.dims ())
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2365 {
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2366 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2367
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2368 retval.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2369
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2370 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
2371
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2372 for (octave_idx_type i = 0; i < nel; i++)
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2373 *pretval++ = betainc (x(i), a, b(i));
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2374 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2375 else
10258
e317791645c4 64-bit fixes
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2376 gripe_betainc_nonconformant (dv, dim_vector (0, 0), b.dims ());
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
2377
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2378 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2379 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2380
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2381 Array<double>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2382 betainc (const Array<double>& x, const Array<double>& a, double b)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2383 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2384 Array<double> retval;
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2385 dim_vector dv = x.dims ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2386
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2387 if (dv == a.dims ())
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2388 {
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2389 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2390
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2391 retval.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2392
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2393 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
2394
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2395 for (octave_idx_type i = 0; i < nel; i++)
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2396 *pretval++ = betainc (x(i), a(i), b);
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2397 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2398 else
10258
e317791645c4 64-bit fixes
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2399 gripe_betainc_nonconformant (dv, a.dims (), dim_vector (0, 0));
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
2400
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2401 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2402 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2403
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2404 Array<double>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2405 betainc (const Array<double>& x, const Array<double>& a, const Array<double>& b)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2406 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2407 Array<double> retval;
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2408 dim_vector dv = x.dims ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2409
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2410 if (dv == a.dims () && dv == b.dims ())
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2411 {
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2412 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2413
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2414 retval.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2415
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2416 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
2417
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2418 for (octave_idx_type i = 0; i < nel; i++)
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2419 *pretval++ = betainc (x(i), a(i), b(i));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2420 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2421 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2422 gripe_betainc_nonconformant (dv, a.dims (), b.dims ());
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2423
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2424 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2425 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2426
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2427 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2428 betainc (float x, float a, float b)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2429 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2430 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2431 F77_XFCN (xbetai, XBETAI, (x, a, b, retval));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2432 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2433 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2434
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2435 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2436 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
2437 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2438 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
2439 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
2440
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2441 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
2442
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2443 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
2444
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2445 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
2446 *pretval++ = betainc (x, a, b(i));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2447
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2448 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2449 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2450
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2451 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2452 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
2453 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2454 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
2455 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
2456
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2457 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
2458
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2459 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
2460
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2461 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
2462 *pretval++ = betainc (x, a(i), b);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2463
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2464 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2465 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2466
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2467 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2468 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
2469 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2470 Array<float> retval;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2471 dim_vector dv = a.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2472
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2473 if (dv == b.dims ())
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2474 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2475 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2476
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2477 retval.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2478
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2479 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
2480
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2481 for (octave_idx_type i = 0; i < nel; i++)
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2482 *pretval++ = betainc (x, a(i), b(i));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2483 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2484 else
10258
e317791645c4 64-bit fixes
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2485 gripe_betainc_nonconformant (dim_vector (0, 0), dv, b.dims ());
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
2486
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2487 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2488 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2489
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2490 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2491 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
2492 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2493 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
2494 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
2495
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2496 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
2497
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2498 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
2499
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2500 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
2501 *pretval++ = betainc (x(i), a, b);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2502
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2503 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2504 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2505
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2506 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2507 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
2508 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2509 Array<float> retval;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2510 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2511
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2512 if (dv == b.dims ())
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2513 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2514 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2515
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2516 retval.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2517
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2518 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
2519
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2520 for (octave_idx_type i = 0; i < nel; i++)
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2521 *pretval++ = betainc (x(i), a, b(i));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2522 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2523 else
10258
e317791645c4 64-bit fixes
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2524 gripe_betainc_nonconformant (dv, dim_vector (0, 0), b.dims ());
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
2525
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2526 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2527 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2528
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2529 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2530 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
2531 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2532 Array<float> retval;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2533 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2534
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2535 if (dv == a.dims ())
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2536 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2537 octave_idx_type nel = dv.numel ();
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 retval.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2540
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2541 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
2542
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2543 for (octave_idx_type i = 0; i < nel; i++)
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2544 *pretval++ = betainc (x(i), a(i), b);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2545 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2546 else
10258
e317791645c4 64-bit fixes
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2547 gripe_betainc_nonconformant (dv, a.dims (), dim_vector (0, 0));
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
2548
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2549 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2550 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2551
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2552 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2553 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
2554 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2555 Array<float> retval;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2556 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2557
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2558 if (dv == a.dims () && dv == b.dims ())
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2559 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2560 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2561
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2562 retval.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2563
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2564 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
2565
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2566 for (octave_idx_type i = 0; i < nel; i++)
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2567 *pretval++ = betainc (x(i), a(i), b(i));
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2568 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2569 else
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2570 gripe_betainc_nonconformant (dv, a.dims (), b.dims ());
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2571
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2572 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2573 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2574
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2575 // FIXME: there is still room for improvement here...
3164
45490c020e47 [project @ 1998-04-14 20:56:48 by jwe]
jwe
parents: 3162
diff changeset
2576
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2577 double
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2578 gammainc (double x, double a, bool& err)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2579 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2580 double retval;
3164
45490c020e47 [project @ 1998-04-14 20:56:48 by jwe]
jwe
parents: 3162
diff changeset
2581
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2582 err = false;
3164
45490c020e47 [project @ 1998-04-14 20:56:48 by jwe]
jwe
parents: 3162
diff changeset
2583
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2584 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
2585 (*current_liboctave_error_handler)
5bd1ca29c5f0 Clean up questionable code bits identified by clang sanitize.
Rik <rik@octave.org>
parents: 18084
diff changeset
2586 ("gammainc: A and X must be non-negative");
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2587 else
5278
fe23ec6763b7 [project @ 2005-04-12 21:04:39 by jwe]
jwe
parents: 5275
diff changeset
2588 F77_XFCN (xgammainc, XGAMMAINC, (a, x, retval));
3164
45490c020e47 [project @ 1998-04-14 20:56:48 by jwe]
jwe
parents: 3162
diff changeset
2589
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2590 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2591 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2592
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2593 Matrix
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2594 gammainc (double x, const Matrix& a)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2595 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2596 octave_idx_type nr = a.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2597 octave_idx_type nc = a.cols ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2598
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2599 Matrix result (nr, nc);
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2600 Matrix retval;
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2601
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2602 bool err;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2603
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2604 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2605 for (octave_idx_type i = 0; i < nr; i++)
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2606 {
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2607 result(i,j) = gammainc (x, a(i,j), err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2608
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2609 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2610 goto done;
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2611 }
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2612
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2613 retval = result;
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2614
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2615 done:
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2616
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2617 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2618 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2619
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2620 Matrix
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2621 gammainc (const Matrix& x, double a)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2622 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2623 octave_idx_type nr = x.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2624 octave_idx_type nc = x.cols ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2625
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2626 Matrix result (nr, nc);
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2627 Matrix retval;
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2628
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2629 bool err;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2630
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2631 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2632 for (octave_idx_type i = 0; i < nr; i++)
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2633 {
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2634 result(i,j) = gammainc (x(i,j), a, err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2635
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2636 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2637 goto done;
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2638 }
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2639
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2640 retval = result;
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2641
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2642 done:
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2643
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2644 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2645 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2646
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2647 Matrix
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2648 gammainc (const Matrix& x, const Matrix& a)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2649 {
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2650 Matrix result;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2651 Matrix retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2652
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2653 octave_idx_type nr = x.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2654 octave_idx_type nc = x.cols ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2655
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2656 octave_idx_type a_nr = a.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2657 octave_idx_type a_nc = a.cols ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2658
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2659 if (nr == a_nr && nc == a_nc)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2660 {
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2661 result.resize (nr, nc);
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2662
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2663 bool err;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2664
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2665 for (octave_idx_type j = 0; j < nc; j++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2666 for (octave_idx_type i = 0; i < nr; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2667 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2668 result(i,j) = gammainc (x(i,j), a(i,j), err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2669
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2670 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2671 goto done;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2672 }
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2673
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2674 retval = result;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2675 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2676 else
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2677 (*current_liboctave_error_handler)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2678 ("gammainc: nonconformant arguments (arg 1 is %dx%d, arg 2 is %dx%d)",
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2679 nr, nc, a_nr, a_nc);
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2680
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2681 done:
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2682
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2683 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2684 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2685
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2686 NDArray
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2687 gammainc (double x, const NDArray& a)
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2688 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2689 dim_vector dv = a.dims ();
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2690 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2691
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2692 NDArray retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2693 NDArray result (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2694
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2695 bool err;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2696
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2697 for (octave_idx_type i = 0; i < nel; i++)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2698 {
18084
8e056300994b Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents: 17769
diff changeset
2699 result(i) = gammainc (x, a(i), err);
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2700
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2701 if (err)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2702 goto done;
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2703 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2704
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2705 retval = result;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2706
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2707 done:
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2708
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2709 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2710 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2711
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2712 NDArray
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2713 gammainc (const NDArray& x, double a)
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2714 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2715 dim_vector dv = x.dims ();
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2716 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2717
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2718 NDArray retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2719 NDArray result (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2720
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2721 bool err;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2722
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2723 for (octave_idx_type i = 0; i < nel; i++)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2724 {
18084
8e056300994b Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents: 17769
diff changeset
2725 result(i) = gammainc (x(i), a, err);
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2726
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2727 if (err)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2728 goto done;
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2729 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2730
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2731 retval = result;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2732
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2733 done:
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2734
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2735 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2736 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2737
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2738 NDArray
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2739 gammainc (const NDArray& x, const NDArray& a)
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2740 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2741 dim_vector dv = x.dims ();
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2742 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2743
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2744 NDArray retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2745 NDArray result;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2746
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2747 if (dv == a.dims ())
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2748 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2749 result.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2750
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2751 bool err;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2752
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2753 for (octave_idx_type i = 0; i < nel; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2754 {
18084
8e056300994b Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents: 17769
diff changeset
2755 result(i) = gammainc (x(i), a(i), err);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
2756
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2757 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2758 goto done;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2759 }
7789
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 retval = result;
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 else
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 std::string x_str = dv.str ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2766 std::string a_str = a.dims ().str ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2767
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2768 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2769 ("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
2770 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
2771 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2772
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2773 done:
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2774
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2775 return retval;
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2778 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2779 gammainc (float x, float a, bool& err)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2780 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2781 float 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 err = false;
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 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
2786 (*current_liboctave_error_handler)
5bd1ca29c5f0 Clean up questionable code bits identified by clang sanitize.
Rik <rik@octave.org>
parents: 18084
diff changeset
2787 ("gammainc: A and X must be non-negative");
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2788 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2789 F77_XFCN (xsgammainc, XSGAMMAINC, (a, x, retval));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2790
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2791 return retval;
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 FloatMatrix
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2795 gammainc (float x, const FloatMatrix& a)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2796 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2797 octave_idx_type nr = a.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2798 octave_idx_type nc = a.cols ();
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 FloatMatrix result (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2801 FloatMatrix retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2802
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2803 bool err;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2804
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2805 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
2806 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
2807 {
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2808 result(i,j) = gammainc (x, a(i,j), err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2809
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2810 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2811 goto done;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2812 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2813
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2814 retval = result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2815
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2816 done:
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2817
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2818 return retval;
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 FloatMatrix
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2822 gammainc (const FloatMatrix& x, float a)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2823 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2824 octave_idx_type nr = x.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2825 octave_idx_type nc = x.cols ();
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 FloatMatrix result (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2828 FloatMatrix retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2829
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2830 bool err;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2831
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2832 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
2833 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
2834 {
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2835 result(i,j) = gammainc (x(i,j), a, err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2836
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2837 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2838 goto done;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2839 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2840
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2841 retval = result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2842
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2843 done:
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2844
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2845 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2846 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2847
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2848 FloatMatrix
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2849 gammainc (const FloatMatrix& x, const FloatMatrix& a)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2850 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2851 FloatMatrix result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2852 FloatMatrix retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2853
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2854 octave_idx_type nr = x.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2855 octave_idx_type nc = x.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2856
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2857 octave_idx_type a_nr = a.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2858 octave_idx_type a_nc = a.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2859
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2860 if (nr == a_nr && nc == a_nc)
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 result.resize (nr, nc);
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 bool err;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2865
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2866 for (octave_idx_type j = 0; j < nc; j++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2867 for (octave_idx_type i = 0; i < nr; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2868 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2869 result(i,j) = gammainc (x(i,j), a(i,j), err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2870
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2871 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2872 goto done;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2873 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2874
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2875 retval = result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2876 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2877 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2878 (*current_liboctave_error_handler)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2879 ("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
2880 nr, nc, a_nr, a_nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2881
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2882 done:
7789
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 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2885 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2886
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2887 FloatNDArray
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2888 gammainc (float x, const FloatNDArray& a)
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 dim_vector dv = a.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2891 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2892
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2893 FloatNDArray retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2894 FloatNDArray result (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2895
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2896 bool err;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2897
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2898 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
2899 {
18084
8e056300994b Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents: 17769
diff changeset
2900 result(i) = gammainc (x, a(i), err);
7789
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 if (err)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2903 goto done;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2904 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2905
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2906 retval = result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2907
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2908 done:
7789
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 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2911 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2912
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2913 FloatNDArray
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2914 gammainc (const FloatNDArray& x, float a)
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 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2917 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2918
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2919 FloatNDArray retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2920 FloatNDArray result (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2921
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2922 bool err;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2923
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2924 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
2925 {
18084
8e056300994b Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents: 17769
diff changeset
2926 result(i) = gammainc (x(i), a, err);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2927
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2928 if (err)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2929 goto done;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2930 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2931
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2932 retval = result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2933
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2934 done:
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2935
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2936 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2937 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2938
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2939 FloatNDArray
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2940 gammainc (const FloatNDArray& x, const FloatNDArray& a)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2941 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2942 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2943 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2944
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2945 FloatNDArray retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2946 FloatNDArray result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2947
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2948 if (dv == a.dims ())
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2949 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2950 result.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2951
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2952 bool err;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2953
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2954 for (octave_idx_type i = 0; i < nel; i++)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2955 {
18084
8e056300994b Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents: 17769
diff changeset
2956 result(i) = gammainc (x(i), a(i), err);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
2957
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2958 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2959 goto done;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2960 }
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2961
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2962 retval = result;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2963 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2964 else
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2965 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2966 std::string x_str = dv.str ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2967 std::string a_str = a.dims ().str ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2968
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2969 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2970 ("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
2971 x_str.c_str (), a_str.c_str ());
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2972 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2973
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2974 done:
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2975
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2976 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2977 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2978
9812
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2979
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2980 Complex rc_log1p (double x)
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2981 {
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2982 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
2983 return (x < -1.0
264ff6bf7475 use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents: 19358
diff changeset
2984 ? 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
2985 : Complex (log1p (x)));
9812
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2986 }
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2987
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2988 FloatComplex rc_log1p (float x)
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2989 {
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2990 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
2991 return (x < -1.0f
264ff6bf7475 use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents: 19358
diff changeset
2992 ? 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
2993 : FloatComplex (log1pf (x)));
9812
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2994 }
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2995
9838
55219e65c7cd fix typo
Jaroslav Hajek <highegg@gmail.com>
parents: 9837
diff changeset
2996 // This algorithm is due to P. J. Acklam.
9837
7c70084b125e improve comment for 9835
Jaroslav Hajek <highegg@gmail.com>
parents: 9835
diff changeset
2997 // See http://home.online.no/~pjacklam/notes/invnorm/
7c70084b125e improve comment for 9835
Jaroslav Hajek <highegg@gmail.com>
parents: 9835
diff changeset
2998 // The rational approximation has relative accuracy 1.15e-9 in the whole region.
14781
e190f6da40f6 maint: Correct comments and use Octave spacing conventions for erfinv.
Rik <octave@nomad.inbox5.com>
parents: 14771
diff changeset
2999 // For doubles, it is refined by a single step of Halley's 3rd order method.
9835
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3000 // For single precision, the accuracy is already OK, so we skip it to get
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3001 // faster evaluation.
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3002
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3003 static double do_erfinv (double x, bool refine)
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3004 {
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3005 // Coefficients of rational approximation.
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
3006 static const double a[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3007 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3008 -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
3009 -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
3010 -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
3011 };
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
3012 static const double b[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3013 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3014 -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
3015 -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
3016 -1.328068155288572e+01
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3017 };
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
3018 static const double c[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3019 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3020 -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
3021 -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
3022 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
3023 };
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
3024 static const double d[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3025 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3026 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
3027 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
3028 };
9835
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3029
14781
e190f6da40f6 maint: Correct comments and use Octave spacing conventions for erfinv.
Rik <octave@nomad.inbox5.com>
parents: 14771
diff changeset
3030 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
3031 static const double pbreak = 0.95150;
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3032 double ax = fabs (x), y;
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 // Select case.
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3035 if (ax <= pbreak)
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3036 {
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3037 // Middle region.
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3038 const double q = 0.5 * x, r = q*q;
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3039 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
3040 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
3041 y = yn / yd;
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 else if (ax < 1.0)
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3044 {
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3045 // Tail region.
19375
264ff6bf7475 use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents: 19358
diff changeset
3046 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
3047 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
3048 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
3049 y = yn / yd * signum (-x);
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3050 }
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3051 else if (ax == 1.0)
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3052 return octave_Inf * signum (x);
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3053 else
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3054 return octave_NaN;
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3055
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3056 if (refine)
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3057 {
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3058 // 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
3059 double u = (erf (y) - x) * spi2 * exp (y*y);
9835
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3060 y -= u / (1 + y*u);
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3061 }
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3062
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3063 return y;
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3064 }
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3065
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3066 double erfinv (double x)
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3067 {
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3068 return do_erfinv (x, true);
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3069 }
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3070
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3071 float erfinv (float x)
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3072 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
3073 return do_erfinv (x, false);
9835
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3074 }
10391
59e34bcdff13 implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents: 10352
diff changeset
3075
14786
e70a0c9cada6 Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14781
diff changeset
3076 // The algorthim for erfcinv is an adaptation of the erfinv algorithm above
e70a0c9cada6 Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14781
diff changeset
3077 // from P. J. Acklam. It has been modified to run over the different input
e70a0c9cada6 Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14781
diff changeset
3078 // domain of erfcinv. See the notes for erfinv for an explanation.
e70a0c9cada6 Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14781
diff changeset
3079
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3080 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
3081 {
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3082 // Coefficients of rational approximation.
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3083 static const double a[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3084 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3085 -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
3086 -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
3087 -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
3088 };
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3089 static const double b[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3090 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3091 -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
3092 -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
3093 -1.328068155288572e+01
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3094 };
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3095 static const double c[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3096 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3097 -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
3098 -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
3099 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
3100 };
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3101 static const double d[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3102 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3103 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
3104 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
3105 };
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3106
14771
10ed11922f19 maint: code cleanup for new erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14770
diff changeset
3107 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
3108 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
3109 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
3110 double y;
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3111
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3112 // Select case.
14786
e70a0c9cada6 Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14781
diff changeset
3113 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
3114 {
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3115 // Middle region.
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3116 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
3117 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
3118 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
3119 y = yn / yd;
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3120 }
14786
e70a0c9cada6 Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14781
diff changeset
3121 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
3122 {
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3123 // Tail region.
19375
264ff6bf7475 use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents: 19358
diff changeset
3124 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
3125 ? 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
3126 : 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
3127
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3128 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
3129
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3130 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
3131
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3132 y = yn / yd;
19375
264ff6bf7475 use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents: 19358
diff changeset
3133
14786
e70a0c9cada6 Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14781
diff changeset
3134 if (x < pbreak_lo)
e70a0c9cada6 Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14781
diff changeset
3135 y = -y;
14770
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 else if (x == 0.0)
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3138 return octave_Inf;
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3139 else if (x == 2.0)
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3140 return -octave_Inf;
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3141 else
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3142 return octave_NaN;
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3143
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3144 if (refine)
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3145 {
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3146 // 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
3147 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
3148 y -= u / (1 + y*u);
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3149 }
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3150
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3151 return y;
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3152 }
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3153
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3154 double erfcinv (double x)
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3155 {
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3156 return do_erfcinv (x, true);
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3157 }
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3158
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3159 float erfcinv (float x)
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3160 {
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3161 return do_erfcinv (x, false);
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3162 }
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3163
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3164 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3165 // Incomplete Beta function ratio
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 // 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
3168 // 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
3169 //
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3170 // 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
3171 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3172 // Reference:
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 // KL Majumder, GP Bhattacharjee,
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3175 // Algorithm AS 63:
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3176 // The incomplete Beta Integral,
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3177 // Applied Statistics,
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3178 // 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
3179 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3180 double
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3181 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
3182 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3183 double acu = 0.1E-14, ai, cx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3184 bool indx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3185 int ns;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3186 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
3187
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3188 value = x;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3189 err = false;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3190
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3191 // Check the input arguments.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3192
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3193 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
3194 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3195 err = true;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3196 return value;
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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3199 // Special cases.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3200
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3201 if (x == 0.0 || x == 1.0)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3202 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3203 return value;
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 // Change tail if necessary and determine S.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3207
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3208 psq = p + q;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3209 cx = 1.0 - x;
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 if (p < psq * x)
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 xx = cx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3214 cx = x;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3215 pp = q;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3216 qq = p;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3217 indx = true;
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 else
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3220 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3221 xx = x;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3222 pp = p;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3223 qq = q;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3224 indx = false;
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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3227 term = 1.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3228 ai = 1.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3229 value = 1.0;
15217
d2220c3def3f avoid C-style cast warning
John W. Eaton <jwe@octave.org>
parents: 15084
diff changeset
3230 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
3231
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3232 // Use the Soper reduction formula.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3233
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3234 rx = xx / cx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3235 temp = qq - ai;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3236 if (ns == 0)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3237 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3238 rx = xx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3239 }
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 for ( ; ; )
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 term = term * temp * rx / (pp + ai);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3244 value = value + term;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3245 temp = fabs (term);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3246
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3247 if (temp <= acu && temp <= acu * value)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3248 {
19375
264ff6bf7475 use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents: 19358
diff changeset
3249 value = value * exp (pp * gnulib::log (xx)
264ff6bf7475 use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents: 19358
diff changeset
3250 + (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
3251
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3252 if (indx)
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 value = 1.0 - value;
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 break;
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 ai = ai + 1.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3260 ns = ns - 1;
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 if (0 <= ns)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3263 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3264 temp = qq - ai;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3265 if (ns == 0)
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 rx = xx;
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 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3270 else
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3271 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3272 temp = psq;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3273 psq = psq + 1.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3274 }
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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3277 return value;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3278 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3279
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3280 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3281 // Inverse of the incomplete Beta function
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3282 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3283 // 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
3284 // 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
3285 //
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3286 // 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
3287 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3288 // Reference:
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3289 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3290 // GW Cran, KJ Martin, GE Thomas,
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3291 // Remark AS R19 and Algorithm AS 109:
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3292 // 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
3293 // 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
3294 // Applied Statistics,
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3295 // 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
3296 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3297 double
15217
d2220c3def3f avoid C-style cast warning
John W. Eaton <jwe@octave.org>
parents: 15084
diff changeset
3298 betaincinv (double y, double p, double q)
d2220c3def3f avoid C-style cast warning
John W. Eaton <jwe@octave.org>
parents: 15084
diff changeset
3299 {
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3300 double a, acu, adj, fpu, g, h;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3301 int iex;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3302 bool indx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3303 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
3304
14847
bcf86cc2f1ee Use xlgamma instead of lgamma in betaincinv for portability across systems.
Rik <octave@nomad.inbox5.com>
parents: 14846
diff changeset
3305 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
3306 bool err = false;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3307 fpu = pow (10.0, sae);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3308 value = y;
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 // Test for admissibility of parameters.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3311
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3312 if (p <= 0.0 || q <= 0.0)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3313 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3314 (*current_liboctave_error_handler)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3315 ("betaincinv: wrong parameters");
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3316 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3317
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3318 if (y < 0.0 || 1.0 < y)
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 (*current_liboctave_error_handler)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3321 ("betaincinv: wrong parameter Y");
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3322 }
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 if (y == 0.0 || y == 1.0)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3325 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3326 return value;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3327 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3328
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3329 // Change tail if necessary.
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 if (0.5 < y)
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 a = 1.0 - y;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3334 pp = q;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3335 qq = p;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3336 indx = true;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3337 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3338 else
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3339 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3340 a = y;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3341 pp = p;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3342 qq = q;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3343 indx = false;
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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3346 // Calculate the initial approximation.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3347
19375
264ff6bf7475 use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents: 19358
diff changeset
3348 r = sqrt (- gnulib::log (a * a));
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3349
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3350 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
3351
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3352 if (1.0 < pp && 1.0 < qq)
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 r = (ycur * ycur - 3.0) / 6.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3355 s = 1.0 / (pp + pp - 1.0);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3356 t = 1.0 / (qq + qq - 1.0);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3357 h = 2.0 / (s + t);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3358 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
3359 value = pp / (pp + qq * exp (w + w));
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3360 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3361 else
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3362 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3363 r = qq + qq;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3364 t = 1.0 / (9.0 * qq);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3365 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
3366
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3367 if (t <= 0.0)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3368 {
19375
264ff6bf7475 use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents: 19358
diff changeset
3369 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
3370 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3371 else
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3372 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3373 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
3374
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3375 if (t <= 1.0)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3376 {
19375
264ff6bf7475 use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents: 19358
diff changeset
3377 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
3378 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3379 else
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 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
3382 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3383 }
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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3386 // 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
3387 // using the function BETAIN.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3388
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3389 r = 1.0 - pp;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3390 t = 1.0 - qq;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3391 yprev = 0.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3392 sq = 1.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3393 prev = 1.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3394
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3395 if (value < 0.0001)
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 value = 0.0001;
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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3400 if (0.9999 < value)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3401 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3402 value = 0.9999;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3403 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3404
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3405 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
3406
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3407 acu = pow (10.0, iex);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3408
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3409 for ( ; ; )
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3410 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3411 ycur = betain (value, pp, qq, beta, err);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3412
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3413 if (err)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3414 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3415 return value;
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 xin = value;
18928
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18678
diff changeset
3419 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
3420 + t * gnulib::log (1.0 - xin));
14816
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 if (ycur * yprev <= 0.0)
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 prev = std::max (sq, fpu);
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 g = 1.0;
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 for ( ; ; )
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 for ( ; ; )
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 adj = g * ycur;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3434 sq = adj * adj;
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 (sq < prev)
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 tx = value - adj;
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 if (0.0 <= tx && tx <= 1.0)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3441 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3442 break;
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 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3445 g = g / 3.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3446 }
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 if (prev <= acu)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3449 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3450 if (indx)
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 value = 1.0 - value;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3453 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3454 return value;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3455 }
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 if (ycur * ycur <= acu)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3458 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3459 if (indx)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3460 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3461 value = 1.0 - value;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3462 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3463 return value;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3464 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3465
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3466 if (tx != 0.0 && tx != 1.0)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3467 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3468 break;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3469 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3470
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3471 g = g / 3.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3472 }
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 if (tx == value)
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 break;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3477 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3478
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3479 value = tx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3480 yprev = ycur;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3481 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3482
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3483 if (indx)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3484 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3485 value = 1.0 - value;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3486 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3487
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3488 return value;
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
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3491 Array<double>
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3492 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
3493 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3494 dim_vector dv = b.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3495 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3496
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3497 Array<double> retval (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3498
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3499 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3500
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3501 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
3502 *pretval++ = betaincinv (x, a, b(i));
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3503
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3504 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3505 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3506
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3507 Array<double>
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3508 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
3509 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3510 dim_vector dv = a.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3511 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3512
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3513 Array<double> retval (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3514
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3515 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3516
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3517 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
3518 *pretval++ = betaincinv (x, a(i), b);
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3519
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3520 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3521 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3522
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3523 Array<double>
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3524 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
3525 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3526 Array<double> retval;
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3527 dim_vector dv = a.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3528
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3529 if (dv == b.dims ())
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3530 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3531 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3532
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3533 retval.resize (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3534
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3535 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3536
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3537 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
3538 *pretval++ = betaincinv (x, a(i), b(i));
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3539 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3540 else
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3541 gripe_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
3542
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3543 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3544 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3545
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3546 Array<double>
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3547 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
3548 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3549 dim_vector dv = x.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3550 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3551
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3552 Array<double> retval (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3553
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3554 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3555
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3556 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
3557 *pretval++ = betaincinv (x(i), a, b);
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3558
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3559 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3560 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3561
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3562 Array<double>
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3563 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
3564 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3565 Array<double> retval;
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3566 dim_vector dv = x.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3567
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3568 if (dv == b.dims ())
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3569 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3570 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3571
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3572 retval.resize (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3573
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3574 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3575
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3576 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
3577 *pretval++ = betaincinv (x(i), a, b(i));
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3578 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3579 else
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3580 gripe_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
3581
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3582 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3583 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3584
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3585 Array<double>
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3586 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
3587 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3588 Array<double> retval;
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3589 dim_vector dv = x.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3590
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3591 if (dv == a.dims ())
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3592 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3593 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3594
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3595 retval.resize (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3596
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3597 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3598
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3599 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
3600 *pretval++ = betaincinv (x(i), a(i), b);
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3601 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3602 else
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3603 gripe_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
3604
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3605 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3606 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3607
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3608 Array<double>
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3609 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
3610 const Array<double>& b)
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3611 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3612 Array<double> retval;
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3613 dim_vector dv = x.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3614
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3615 if (dv == a.dims () && dv == b.dims ())
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3616 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3617 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3618
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3619 retval.resize (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3620
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3621 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3622
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3623 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
3624 *pretval++ = betaincinv (x(i), a(i), b(i));
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3625 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3626 else
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3627 gripe_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
3628
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3629 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3630 }
17502
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3631
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3632 void
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3633 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
3634 {
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3635 static const int Nmax = 16;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3636 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
3637 int n, Nn, ii;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3638
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3639 if (m < 0 || m > 1)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3640 {
19410
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19377
diff changeset
3641 (*current_liboctave_warning_with_id_handler)
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19377
diff changeset
3642 ("Octave:ellipj-invalid-m", "ellipj: expecting 0 <= M <= 1");
95c533ed464b use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents: 19377
diff changeset
3643
17502
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3644 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
3645
17502
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3646 return;
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
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3649 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
3650 if (m < sqrt_eps)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3651 {
18678
6113e0c6920b maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents: 18676
diff changeset
3652 // 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
3653 si_u = sin (u);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3654 co_u = cos (u);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3655 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
3656 sn = si_u - t * co_u;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3657 cn = co_u + t * si_u;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3658 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
3659 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3660 else if ((1 - m) < sqrt_eps)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3661 {
18678
6113e0c6920b maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents: 18676
diff changeset
3662 // 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
3663 m1 = 1 - m;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3664 si_u = sinh (u);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3665 co_u = cosh (u);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3666 ta_u = tanh (u);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3667 se_u = 1/co_u;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3668 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
3669 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
3670 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
3671 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3672 else
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3673 {
18678
6113e0c6920b maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents: 18676
diff changeset
3674 // Arithmetic-Geometric Mean (AGM) algorithm
6113e0c6920b maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents: 18676
diff changeset
3675 // (Abramowitz and Stegun, Section 16.4)
17502
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3676 a[0] = 1;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3677 b = sqrt (1 - m);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3678 c[0] = sqrt (m);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3679 for (n = 1; n < Nmax; ++n)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3680 {
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3681 a[n] = (a[n - 1] + b)/2;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3682 c[n] = (a[n - 1] - b)/2;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3683 b = sqrt (a[n - 1]*b);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3684 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
3685 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3686 if (n >= Nmax - 1)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3687 {
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3688 err = 1;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3689 return;
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 Nn = n;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3692 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
3693 phi = ii*a[Nn]*u;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3694 for (n = Nn; n > 0; --n)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3695 {
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3696 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
3697 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3698 sn = sin (phi);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3699 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
3700 dn = sqrt (1 - m*sn*sn);
17502
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3701 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3702 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3703
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3704 void
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3705 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
3706 double& err)
17502
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3707 {
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3708 double m1 = 1 - m, ss1, cc1, dd1;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3709
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3710 ellipj (imag (u), m1, ss1, cc1, dd1, err);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3711 if (real (u) == 0)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3712 {
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3713 // u is pure imag: Jacoby imag. transf.
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3714 sn = Complex (0, ss1/cc1);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3715 cn = 1/cc1; // cn.imag = 0;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3716 dn = dd1/cc1; // dn.imag = 0;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3717 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3718 else
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3719 {
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3720 // u is generic complex
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3721 double ss, cc, dd, ddd;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3722
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3723 ellipj (real (u), m, ss, cc, dd, err);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3724 ddd = cc1*cc1 + m*ss*ss*ss1*ss1;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3725 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
3726 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
3727 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
3728 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3729 }
20154
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3730
20155
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3731 static const double pi = 3.14159265358979323846;
20156
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3732
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3733 template<class T>
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3734 T
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3735 Lanczos_approximation_psi (const T zc)
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3736 {
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3737 // Coefficients for C.Lanczos expansion of psi function from XLiFE++ gammaFunctions
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3738 // psi_coef[k] = - (2k+1) * lg_coef[k] (see melina++ gamma functions)
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3739 // -1/12, 3/360,-5/1260, 7/1680,-9/1188, 11*691/360360,-13/156, 15*3617/122400, ? , ?
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3740 static const T dg_coeff[10] = {
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3741 -0.83333333333333333e-1, 0.83333333333333333e-2,
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3742 -0.39682539682539683e-2, 0.41666666666666667e-2,
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3743 -0.75757575757575758e-2, 0.21092796092796093e-1,
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3744 -0.83333333333333333e-1, 0.4432598039215686,
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3745 -0.3053954330270122e+1, 0.125318899521531e+2
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3746 };
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3747
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3748 T overz2 = T (1.0) / (zc * zc);
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3749 T overz2k = overz2;
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3750
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3751 T p = 0;
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3752 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
3753 p += dg_coeff[k] * overz2k;
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3754 p += log (zc) - T (0.5) / zc;
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3755 return p;
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3756 }
20155
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3757
20154
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3758 template<class T>
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3759 T
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3760 psi (const T& z)
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3761 {
20156
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3762 static const double euler_mascheroni = 0.577215664901532860606512090082402431042;
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3763
20154
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3764 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
3765
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3766 T p = 0;
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3767 if (z <= 0)
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 // limits - zeros of the gamma function
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3770 if (is_int)
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3771 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
3772 else
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3773 // 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
3774 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
3775 }
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3776 else if (is_int)
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3777 {
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3778 // 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
3779 p = - euler_mascheroni;
20156
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3780 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
3781 p += 1.0 / k;
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3782 }
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3783 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
3784 {
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3785 // 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
3786 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
3787 p += 1.0 / (2 * k - 1);
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3788
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3789 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
3790 }
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3791 else
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 // adapted from XLiFE++ gammaFunctions
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3794
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3795 T zc = z;
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3796 // 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
3797 if (z < 10)
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3798 {
20156
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3799 const signed char n = 10 - z;
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3800 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
3801 p -= 1.0 / (k + z);
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3802 zc += n;
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3803 }
20156
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3804 p += Lanczos_approximation_psi (zc);
20154
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3805 }
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3806
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3807 return p;
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3808 }
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3809
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3810 // explicit instantiations
45565ecec019 New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents: 19739
diff changeset
3811 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
3812 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
3813
20155
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3814 template<class T>
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3815 std::complex<T>
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3816 psi (const std::complex<T>& z)
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3817 {
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3818 // adapted from XLiFE++ gammaFunctions
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3819
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3820 typedef typename std::complex<T>::value_type P;
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3821
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3822 P z_r = z.real ();
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3823 P z_ra = z_r;
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3824
20156
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3825 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
3826 if (z.imag () == 0)
20156
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3827 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
3828 else if (z_r < 0)
20156
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3829 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
3830 else
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3831 {
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3832 // Use formula for derivative of LogGamma(z)
20156
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3833 std::complex<T> z_m = z;
20155
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3834 if (z_ra < 8)
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3835 {
20156
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3836 unsigned char n = 8 - z_ra;
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3837 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
3838
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3839 // Recurrence formula
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3840 // for | Re(z) | < 8 , use recursively DiGamma(z) = DiGamma(z+1) - 1/z
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3841 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
3842 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
3843 dgam -= P (1.0) / z_p;
20155
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3844 }
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3845
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3846 // for | Re(z) | > 8, use derivative of C.Lanczos expansion for LogGamma
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3847 // psi(z) = log(z) - 1/(2z) - 1/12z^2 + 3/360z^4 - 5/1260z^6 + 7/1680z^8 - 9/1188z^10 + ...
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3848 // (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
3849 dgam += Lanczos_approximation_psi (z_m);
20155
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3850 }
20156
bd565f3e0ecb psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents: 20155
diff changeset
3851 return dgam;
20155
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3852 }
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3853
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3854 // explicit instantiations
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3855 template Complex psi<double> (const Complex& z);
1fae49e34a1a psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents: 20154
diff changeset
3856 template FloatComplex psi<float> (const FloatComplex& z);