Mercurial > hg > octave-nkf

annotate liboctave/numeric/lo-specfun.cc @ 19118:161ebb78ac1b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
use gnulib::log and gnulib::logf functions * Faddeeva.cc, lo-mappers.cc, lo-specfun.cc: Use gnulib::log and gnulib::logf instead of log and logf.
author John W. Eaton <jwe@octave.org>
date Wed, 16 Jul 2014 19:56:22 -0400
parents 6113e0c6920b
children 068a3e51b7b8
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
17744
d63878346099 maint: Update copyright notices for release.
John W. Eaton <jwe@octave.org>
parents: 17741
diff changeset
3 Copyright (C) 1996-2013 John W. Eaton
10391
59e34bcdff13 implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents: 10352
diff changeset
4 Copyright (C) 2010 Jaroslav Hajek
10521
4d1fc073fbb7 add some missing copyright stmts
Jaroslav Hajek <highegg@gmail.com>
parents: 10414
diff changeset
5 Copyright (C) 2010 VZLU Prague
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
6
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
7 This file is part of Octave.
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 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
10 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
11 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
12 option) any later version.
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
13
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
14 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
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
16 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
17 for more details.
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
18
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
19 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
20 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
21 <http://www.gnu.org/licenses/>.
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
22
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
23 */
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 #ifdef HAVE_CONFIG_H
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
26 #include <config.h>
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
27 #endif
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
28
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
29 #include "Range.h"
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
30 #include "CColVector.h"
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
31 #include "CMatrix.h"
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
32 #include "dRowVector.h"
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
33 #include "dMatrix.h"
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
34 #include "dNDArray.h"
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
35 #include "CNDArray.h"
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
36 #include "fCColVector.h"
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
37 #include "fCMatrix.h"
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
38 #include "fRowVector.h"
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
39 #include "fMatrix.h"
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
40 #include "fNDArray.h"
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
41 #include "fCNDArray.h"
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
42 #include "f77-fcn.h"
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
43 #include "lo-error.h"
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
44 #include "lo-ieee.h"
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
45 #include "lo-specfun.h"
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
46 #include "mx-inlines.cc"
5701
252b6754e545 [project @ 2006-03-21 18:15:42 by jwe]
jwe
parents: 5700
diff changeset
47 #include "lo-mappers.h"
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
48
15696
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
49 #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
50
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
51 extern "C"
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
52 {
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
53 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
54 F77_FUNC (zbesj, ZBESJ) (const double&, const double&, const double&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
55 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
56 double*, double*, octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
57 octave_idx_type&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
58
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
59 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
60 F77_FUNC (zbesy, ZBESY) (const double&, const double&, const double&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
61 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
62 double*, double*, octave_idx_type&, double*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
63 double*, octave_idx_type&);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
64
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
65 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
66 F77_FUNC (zbesi, ZBESI) (const double&, const double&, const double&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
67 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
68 double*, double*, octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
69 octave_idx_type&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
70
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
71 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
72 F77_FUNC (zbesk, ZBESK) (const double&, const double&, const double&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
73 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
74 double*, double*, octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
75 octave_idx_type&);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
76
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
77 F77_RET_T
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
78 F77_FUNC (zbesh, ZBESH) (const double&, const double&, const double&,
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
79 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
80 const octave_idx_type&, double*, double*,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
81 octave_idx_type&, octave_idx_type&);
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
82
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
83 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
84 F77_FUNC (cbesj, cBESJ) (const FloatComplex&, const float&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
85 const octave_idx_type&, const octave_idx_type&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
86 FloatComplex*, octave_idx_type&, octave_idx_type&);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
87
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
88 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
89 F77_FUNC (cbesy, CBESY) (const FloatComplex&, const float&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
90 const octave_idx_type&, const octave_idx_type&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
91 FloatComplex*, octave_idx_type&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
92 FloatComplex*, octave_idx_type&);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
93
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
94 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
95 F77_FUNC (cbesi, CBESI) (const FloatComplex&, const float&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
96 const octave_idx_type&, const octave_idx_type&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
97 FloatComplex*, octave_idx_type&, octave_idx_type&);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
98
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
99 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
100 F77_FUNC (cbesk, CBESK) (const FloatComplex&, const float&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
101 const octave_idx_type&, const octave_idx_type&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
102 FloatComplex*, octave_idx_type&, octave_idx_type&);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
103
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
104 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
105 F77_FUNC (cbesh, CBESH) (const FloatComplex&, const float&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
106 const octave_idx_type&, const octave_idx_type&,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
107 const octave_idx_type&, FloatComplex*,
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
108 octave_idx_type&, octave_idx_type&);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
109
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
110 F77_RET_T
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
111 F77_FUNC (zairy, ZAIRY) (const double&, const double&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
112 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
113 double&, double&, octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
114 octave_idx_type&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
115
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
116 F77_RET_T
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
117 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
118 const octave_idx_type&, float&, float&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
119 octave_idx_type&, octave_idx_type&);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
120
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
121 F77_RET_T
11518
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
122 F77_FUNC (zbiry, ZBIRY) (const double&, const double&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
123 const octave_idx_type&, const octave_idx_type&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
124 double&, double&, octave_idx_type&);
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
125
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
126 F77_RET_T
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
127 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
128 const octave_idx_type&, float&, float&,
141b3fb5cef7 style fixes
John W. Eaton <jwe@octave.org>
parents: 11327
diff changeset
129 octave_idx_type&);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
130
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
131 F77_RET_T
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
132 F77_FUNC (xdacosh, XDACOSH) (const double&, double&);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
133
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
134 F77_RET_T
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
135 F77_FUNC (xacosh, XACOSH) (const float&, float&);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
136
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
137 F77_RET_T
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
138 F77_FUNC (xdasinh, XDASINH) (const double&, double&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
139
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
140 F77_RET_T
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
141 F77_FUNC (xasinh, XASINH) (const float&, float&);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
142
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
143 F77_RET_T
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
144 F77_FUNC (xdatanh, XDATANH) (const double&, double&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
145
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
146 F77_RET_T
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
147 F77_FUNC (xatanh, XATANH) (const float&, float&);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
148
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
149 F77_RET_T
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
150 F77_FUNC (xderf, XDERF) (const double&, double&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
151
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
152 F77_RET_T
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
153 F77_FUNC (xerf, XERF) (const float&, float&);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
154
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
155 F77_RET_T
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
156 F77_FUNC (xderfc, XDERFC) (const double&, double&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
157
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
158 F77_RET_T
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
159 F77_FUNC (xerfc, XERFC) (const float&, float&);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
160
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
161 F77_RET_T
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
162 F77_FUNC (xdbetai, XDBETAI) (const double&, const double&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
163 const double&, double&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
164
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
165 F77_RET_T
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
166 F77_FUNC (xbetai, XBETAI) (const float&, const float&,
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
167 const float&, float&);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
168
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
169 F77_RET_T
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
170 F77_FUNC (xdgamma, XDGAMMA) (const double&, double&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
171
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
172 F77_RET_T
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
173 F77_FUNC (xgamma, XGAMMA) (const float&, float&);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
174
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
175 F77_RET_T
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
176 F77_FUNC (xgammainc, XGAMMAINC) (const double&, const double&, double&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
177
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
178 F77_RET_T
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
179 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
180
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
181 F77_RET_T
4552
6f3382e08a52 [project @ 2003-10-27 20:38:02 by jwe]
jwe
parents: 4506
diff changeset
182 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
183
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
184 F77_RET_T
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
185 F77_FUNC (algams, ALGAMS) (const float&, float&, float&);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
186 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
187
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
188 #if !defined (HAVE_ACOSH)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
189 double
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
190 acosh (double x)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
191 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
192 double retval;
5278
fe23ec6763b7 [project @ 2005-04-12 21:04:39 by jwe]
jwe
parents: 5275
diff changeset
193 F77_XFCN (xdacosh, XDACOSH, (x, retval));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
194 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
195 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
196 #endif
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
197
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
198 #if !defined (HAVE_ACOSHF)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
199 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
200 acoshf (float x)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
201 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
202 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
203 F77_XFCN (xacosh, XACOSH, (x, retval));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
204 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
205 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
206 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
207
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
208 #if !defined (HAVE_ASINH)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
209 double
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
210 asinh (double x)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
211 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
212 double retval;
5278
fe23ec6763b7 [project @ 2005-04-12 21:04:39 by jwe]
jwe
parents: 5275
diff changeset
213 F77_XFCN (xdasinh, XDASINH, (x, retval));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
214 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
215 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
216 #endif
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
217
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
218 #if !defined (HAVE_ASINHF)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
219 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
220 asinhf (float x)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
221 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
222 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
223 F77_XFCN (xasinh, XASINH, (x, retval));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
224 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
225 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
226 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
227
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
228 #if !defined (HAVE_ATANH)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
229 double
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
230 atanh (double x)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
231 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
232 double retval;
5278
fe23ec6763b7 [project @ 2005-04-12 21:04:39 by jwe]
jwe
parents: 5275
diff changeset
233 F77_XFCN (xdatanh, XDATANH, (x, retval));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
234 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
235 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
236 #endif
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
237
7914
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
238 #if !defined (HAVE_ATANHF)
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
239 float
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
240 atanhf (float x)
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
241 {
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
242 float retval;
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
243 F77_XFCN (xatanh, XATANH, (x, retval));
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
244 return retval;
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
245 }
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
246 #endif
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
247
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
248 #if !defined (HAVE_ERF)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
249 double
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
250 erf (double x)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
251 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
252 double retval;
5278
fe23ec6763b7 [project @ 2005-04-12 21:04:39 by jwe]
jwe
parents: 5275
diff changeset
253 F77_XFCN (xderf, XDERF, (x, retval));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
254 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
255 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
256 #endif
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
257
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
258 #if !defined (HAVE_ERFF)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
259 float
7914
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
260 erff (float x)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
261 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
262 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
263 F77_XFCN (xerf, XERF, (x, retval));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
264 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
265 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
266 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
267
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
268 #if !defined (HAVE_ERFC)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
269 double
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
270 erfc (double x)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
271 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
272 double retval;
5278
fe23ec6763b7 [project @ 2005-04-12 21:04:39 by jwe]
jwe
parents: 5275
diff changeset
273 F77_XFCN (xderfc, XDERFC, (x, retval));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
274 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
275 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
276 #endif
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
277
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
278 #if !defined (HAVE_ERFCF)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
279 float
7914
e998e81224b5 Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
280 erfcf (float x)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
281 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
282 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
283 F77_XFCN (xerfc, XERFC, (x, retval));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
284 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
285 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
286 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
287
15696
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
288 // 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
289 Complex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
290 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
291 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
292 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
293 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
294 FloatComplex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
295 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
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 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
298 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
299 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
300 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
301
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
302 // Complex 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
303 Complex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
304 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
305 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
306 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
307 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
308 FloatComplex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
309 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
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 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
312 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
313 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
314 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
315
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
316 // 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
317 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
318 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
319 Complex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
320 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
321 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
322 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
323 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
324 FloatComplex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
325 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
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 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
328 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
329 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
330 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
331
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
332 // 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
333 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
334 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
335 Complex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
336 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
337 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
338 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
339 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
340 FloatComplex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
341 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
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 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
344 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
345 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
346 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
347
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
348 // 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
349 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
350 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
351 Complex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
352 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
353 {
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
354 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
355 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
356 FloatComplex
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
357 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
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 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
360 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
361 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
362 }
2fac72a256ce Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents: 15271
diff changeset
363
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
364 double
3156
a494f93e60ff [project @ 1998-02-20 07:47:48 by jwe]
jwe
parents: 3146
diff changeset
365 xgamma (double x)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
366 {
3156
a494f93e60ff [project @ 1998-02-20 07:47:48 by jwe]
jwe
parents: 3146
diff changeset
367 double result;
5701
252b6754e545 [project @ 2006-03-21 18:15:42 by jwe]
jwe
parents: 5700
diff changeset
368
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
369 if (xisnan (x) || (x < 0 && (xisinf (x) || D_NINT (x) == x)))
f10b7a578e2c Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents: 17502
diff changeset
370 result = octave_NaN;
f10b7a578e2c Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents: 17502
diff changeset
371 else if (x == 0 && xnegative_sign (x))
f10b7a578e2c Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents: 17502
diff changeset
372 result = -octave_Inf;
f10b7a578e2c Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents: 17502
diff changeset
373 else if (x == 0 || xisinf (x))
5701
252b6754e545 [project @ 2006-03-21 18:15:42 by jwe]
jwe
parents: 5700
diff changeset
374 result = octave_Inf;
252b6754e545 [project @ 2006-03-21 18:15:42 by jwe]
jwe
parents: 5700
diff changeset
375 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
376 {
11327
ef0e995f8c0f correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents: 10902
diff changeset
377 #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
378 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
379 #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
380 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
381 #endif
17741
f6293489fe88 avoid warnings about casts and gnulib functions
John W. Eaton <jwe@octave.org>
parents: 17708
diff changeset
382 if (xisinf (result) && (static_cast<int> (gnulib::floor (x)) % 2))
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
383 result = -octave_Inf;
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 }
6969
0a64abe792f4 [project @ 2007-10-06 14:15:19 by jwe]
jwe
parents: 6961
diff changeset
385
3156
a494f93e60ff [project @ 1998-02-20 07:47:48 by jwe]
jwe
parents: 3146
diff changeset
386 return result;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
387 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
388
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
389 double
3156
a494f93e60ff [project @ 1998-02-20 07:47:48 by jwe]
jwe
parents: 3146
diff changeset
390 xlgamma (double x)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
391 {
6969
0a64abe792f4 [project @ 2007-10-06 14:15:19 by jwe]
jwe
parents: 6961
diff changeset
392 #if defined (HAVE_LGAMMA)
0a64abe792f4 [project @ 2007-10-06 14:15:19 by jwe]
jwe
parents: 6961
diff changeset
393 return lgamma (x);
0a64abe792f4 [project @ 2007-10-06 14:15:19 by jwe]
jwe
parents: 6961
diff changeset
394 #else
3156
a494f93e60ff [project @ 1998-02-20 07:47:48 by jwe]
jwe
parents: 3146
diff changeset
395 double result;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
396 double sgngam;
4497
2a02f3a16fe0 [project @ 2003-09-04 18:48:13 by jwe]
jwe
parents: 4490
diff changeset
397
5701
252b6754e545 [project @ 2006-03-21 18:15:42 by jwe]
jwe
parents: 5700
diff changeset
398 if (xisnan (x))
252b6754e545 [project @ 2006-03-21 18:15:42 by jwe]
jwe
parents: 5700
diff changeset
399 result = x;
10902
9a64e02e2aad Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents: 10521
diff changeset
400 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
401 result = octave_Inf;
5700
67118c88cee7 [project @ 2006-03-21 17:31:45 by jwe]
jwe
parents: 5307
diff changeset
402 else
67118c88cee7 [project @ 2006-03-21 17:31:45 by jwe]
jwe
parents: 5307
diff changeset
403 F77_XFCN (dlgams, DLGAMS, (x, result, sgngam));
4497
2a02f3a16fe0 [project @ 2003-09-04 18:48:13 by jwe]
jwe
parents: 4490
diff changeset
404
3156
a494f93e60ff [project @ 1998-02-20 07:47:48 by jwe]
jwe
parents: 3146
diff changeset
405 return result;
6969
0a64abe792f4 [project @ 2007-10-06 14:15:19 by jwe]
jwe
parents: 6961
diff changeset
406 #endif
6961
b559b4bcf51f [project @ 2007-10-05 19:35:21 by jwe]
jwe
parents: 5775
diff changeset
407 }
b559b4bcf51f [project @ 2007-10-05 19:35:21 by jwe]
jwe
parents: 5775
diff changeset
408
7601
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
409 Complex
9812
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
410 rc_lgamma (double x)
7601
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
411 {
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
412 double result;
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
413
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
414 #if defined (HAVE_LGAMMA_R)
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
415 int sgngam;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
416 result = lgamma_r (x, &sgngam);
7601
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
417 #else
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
418 double sgngam;
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
419
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
420 if (xisnan (x))
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
421 result = x;
10902
9a64e02e2aad Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents: 10521
diff changeset
422 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
423 result = octave_Inf;
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
424 else
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
425 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
426
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
427 #endif
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
428
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
429 if (sgngam < 0)
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
430 return result + Complex (0., M_PI);
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
431 else
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
432 return result;
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
433 }
8a939b217863 Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents: 7176
diff changeset
434
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
435 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
436 xgamma (float x)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
437 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
438 float result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
439
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
440 if (xisnan (x) || (x < 0 && (xisinf (x) || D_NINT (x) == x)))
f10b7a578e2c Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents: 17502
diff changeset
441 result = octave_Float_NaN;
f10b7a578e2c Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents: 17502
diff changeset
442 else if (x == 0 && xnegative_sign (x))
f10b7a578e2c Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents: 17502
diff changeset
443 result = -octave_Float_Inf;
f10b7a578e2c Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents: 17502
diff changeset
444 else if (x == 0 || xisinf (x))
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
445 result = octave_Float_Inf;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
446 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
447 {
f10b7a578e2c Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents: 17502
diff changeset
448 #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
449 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
450 #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
451 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
452 #endif
17741
f6293489fe88 avoid warnings about casts and gnulib functions
John W. Eaton <jwe@octave.org>
parents: 17708
diff changeset
453 if (xisinf (result) && (static_cast<int> (gnulib::floor (x)) % 2))
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 result = -octave_Float_Inf;
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 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
456
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
457 return result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
458 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
459
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
460 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
461 xlgamma (float x)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
462 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
463 #if defined (HAVE_LGAMMAF)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
464 return lgammaf (x);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
465 #else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
466 float result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
467 float sgngam;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
468
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
469 if (xisnan (x))
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
470 result = x;
10902
9a64e02e2aad Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents: 10521
diff changeset
471 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
472 result = octave_Float_Inf;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
473 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
474 F77_XFCN (algams, ALGAMS, (x, result, sgngam));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
475
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
476 return result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
477 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
478 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
479
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
480 FloatComplex
9812
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
481 rc_lgamma (float x)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
482 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
483 float result;
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 #if defined (HAVE_LGAMMAF_R)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
486 int sgngam;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
487 result = lgammaf_r (x, &sgngam);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
488 #else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
489 float sgngam;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
490
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
491 if (xisnan (x))
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
492 result = x;
10902
9a64e02e2aad Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents: 10521
diff changeset
493 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
494 result = octave_Float_Inf;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
495 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
496 F77_XFCN (algams, ALGAMS, (x, result, sgngam));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
497
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
498 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
499
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
500 if (sgngam < 0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
501 return result + FloatComplex (0., M_PI);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
502 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
503 return result;
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
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
506 #if !defined (HAVE_EXPM1)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
507 double
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
508 expm1 (double x)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
509 {
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
510 double retval;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
511
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
512 double ax = fabs (x);
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
513
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
514 if (ax < 0.1)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
515 {
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
516 ax /= 16;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
517
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
518 // use Taylor series to calculate exp(x)-1.
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
519 double t = ax;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
520 double s = 0;
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
521 for (int i = 2; i < 7; i++)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
522 s += (t *= ax/i);
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
523 s += ax;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
524
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
525 // 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
526 double e = s;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
527 for (int i = 0; i < 4; i++)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
528 {
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
529 s *= e + 2;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
530 e *= e + 2;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
531 }
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
532
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
533 retval = (x > 0) ? s : -s / (1+s);
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
534 }
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
535 else
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
536 retval = exp (x) - 1;
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 return retval;
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 #endif
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
541
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
542 Complex
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14847
diff changeset
543 expm1 (const Complex& x)
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
544 {
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
545 Complex retval;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
546
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
547 if (std:: abs (x) < 1)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
548 {
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
549 double im = x.imag ();
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
550 double u = expm1 (x.real ());
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
551 double v = sin (im/2);
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
552 v = -2*v*v;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
553 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
554 }
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
555 else
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
556 retval = std::exp (x) - Complex (1);
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
557
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
558 return retval;
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
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
561 #if !defined (HAVE_EXPM1F)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
562 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
563 expm1f (float x)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
564 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
565 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
566
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
567 float ax = fabs (x);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
568
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
569 if (ax < 0.1)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
570 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
571 ax /= 16;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
572
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
573 // use Taylor series to calculate exp(x)-1.
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
574 float t = ax;
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
575 float s = 0;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
576 for (int i = 2; i < 7; i++)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
577 s += (t *= ax/i);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
578 s += ax;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
579
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
580 // 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
581 float e = s;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
582 for (int i = 0; i < 4; i++)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
583 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
584 s *= e + 2;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
585 e *= e + 2;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
586 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
587
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
588 retval = (x > 0) ? s : -s / (1+s);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
589 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
590 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
591 retval = exp (x) - 1;
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 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
594 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
595 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
596
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
597 FloatComplex
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14847
diff changeset
598 expm1 (const FloatComplex& x)
7789
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 FloatComplex retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
601
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
602 if (std:: abs (x) < 1)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
603 {
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
604 float im = x.imag ();
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
605 float u = expm1 (x.real ());
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
606 float v = sin (im/2);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
607 v = -2*v*v;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
608 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
609 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
610 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
611 retval = std::exp (x) - FloatComplex (1);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
612
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
613 return retval;
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
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
616 #if !defined (HAVE_LOG1P)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
617 double
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
618 log1p (double x)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
619 {
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
620 double retval;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
621
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
622 double ax = fabs (x);
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
623
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
624 if (ax < 0.2)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
625 {
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
626 // 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
627 double u = x / (2 + x), t = 1, s = 0;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
628 for (int i = 2; i < 12; i += 2)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
629 s += (t *= u*u) / (i+1);
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
630
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
631 retval = 2 * (s + 1) * u;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
632 }
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
633 else
19118
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
634 retval = gnulib::log (1 + x);
7638
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 return retval;
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 #endif
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
639
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
640 Complex
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
641 log1p (const Complex& x)
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 Complex retval;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
644
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
645 double r = x.real (), i = x.imag ();
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
646
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
647 if (fabs (r) < 0.5 && fabs (i) < 0.5)
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
648 {
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
649 double u = 2*r + r*r + i*i;
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
650 retval = Complex (log1p (u / (1+sqrt (u+1))),
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
651 atan2 (1 + r, i));
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
652 }
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
653 else
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14847
diff changeset
654 retval = std::log (Complex (1) + x);
7638
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
655
2df457529cfa implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents: 7601
diff changeset
656 return retval;
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
10414
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
659 #if !defined (HAVE_CBRT)
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
660 double cbrt (double x)
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
661 {
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
662 static const double one_third = 0.3333333333333333333;
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
663 if (xfinite (x))
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
664 {
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
665 // Use pow.
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
666 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
667 // Correct for better accuracy.
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
668 return (x / (y*y) + y + y) / 3;
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 else
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
671 return x;
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
672 }
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
673 #endif
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
674
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
675 #if !defined (HAVE_LOG1PF)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
676 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
677 log1pf (float x)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
678 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
679 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
680
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
681 float ax = fabs (x);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
682
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
683 if (ax < 0.2)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
684 {
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
685 // approximation log (1+x) ~ 2*sum ((x/(2+x)).^ii ./ ii), ii = 1:2:2n+1
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
686 float u = x / (2 + x), t = 1, s = 0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
687 for (int i = 2; i < 12; i += 2)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
688 s += (t *= u*u) / (i+1);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
689
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
690 retval = 2 * (s + 1) * u;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
691 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
692 else
19118
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
693 retval = gnulib::logf (1 + x);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
694
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
695 return retval;
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 #endif
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
698
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
699 FloatComplex
9812
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
700 log1p (const FloatComplex& x)
7789
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 FloatComplex retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
703
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
704 float r = x.real (), i = x.imag ();
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
705
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
706 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
707 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
708 float u = 2*r + r*r + i*i;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
709 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
710 atan2 (1 + r, i));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
711 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
712 else
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14847
diff changeset
713 retval = std::log (FloatComplex (1) + x);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
714
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
715 return retval;
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
10414
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
718 #if !defined (HAVE_CBRTF)
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
719 float cbrtf (float x)
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
720 {
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
721 static const float one_third = 0.3333333333333333333f;
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
722 if (xfinite (x))
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
723 {
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
724 // Use pow.
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
725 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
726 // Correct for better accuracy.
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
727 return (x / (y*y) + y + y) / 3;
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 else
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
730 return x;
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
731 }
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
732 #endif
2a8b1db1e2ca implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents: 10391
diff changeset
733
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
734 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
735 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
736
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
737 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
738 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
739
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
740 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
741 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
742
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
743 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
744 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
745
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
746 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
747 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
748
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
749 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
750 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
751
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
752 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
753 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
754 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
755 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
756 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
757
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
758 Complex retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
759
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
760 switch (ierr)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
761 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
762 case 0:
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
763 case 3:
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
764 retval = val;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
765 break;
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 2:
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
768 retval = inf_val;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
769 break;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
770
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
771 default:
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
772 retval = nan_val;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
773 break;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
774 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
775
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
776 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
777 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
778
4911
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
779 static inline bool
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
780 is_integer_value (double x)
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
781 {
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
782 return x == static_cast<double> (static_cast<long> (x));
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
783 }
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
784
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
785 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
786 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
787 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
788 Complex retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
789
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
790 if (alpha >= 0.0)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
791 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
792 double yr = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
793 double yi = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
794
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
795 octave_idx_type nz;
3220
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 zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
798 double zi = z.imag ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
799
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
800 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
801
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
802 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
803 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
804 double expz = exp (std::abs (zi));
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
805 yr *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
806 yi *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
807 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
808
4490
1aed172ab84a [project @ 2003-08-28 19:03:06 by jwe]
jwe
parents: 4180
diff changeset
809 if (zi == 0.0 && zr >= 0.0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
810 yi = 0.0;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
811
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
812 retval = bessel_return_value (Complex (yr, yi), ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
813 }
4911
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
814 else if (is_integer_value (alpha))
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
815 {
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
816 // 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
817 alpha = -alpha;
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
818 Complex tmp = zbesj (z, alpha, kode, ierr);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
819 if ((static_cast <long> (alpha)) & 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
820 tmp = - tmp;
4911
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
821 retval = bessel_return_value (tmp, ierr);
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
822 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
823 else
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
824 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
825 alpha = -alpha;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
826
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
827 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
828
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
829 if (ierr == 0 || ierr == 3)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
830 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
831 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
832
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
833 retval = bessel_return_value (tmp, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
834 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
835 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
836 retval = Complex (octave_NaN, octave_NaN);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
837 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
838
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
839 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
840 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
841
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
842 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
843 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
844 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
845 Complex retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
846
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
847 if (alpha >= 0.0)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
848 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
849 double yr = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
850 double yi = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
851
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
852 octave_idx_type nz;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
853
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
854 double wr, wi;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
855
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
856 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
857 double zi = z.imag ();
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 ierr = 0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
860
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
861 if (zr == 0.0 && zi == 0.0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
862 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
863 yr = -octave_Inf;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
864 yi = 0.0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
865 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
866 else
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 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
869 &wr, &wi, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
870
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
871 if (kode != 2)
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 double expz = exp (std::abs (zi));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
874 yr *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
875 yi *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
876 }
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 if (zi == 0.0 && zr >= 0.0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
879 yi = 0.0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
880 }
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
881
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
882 return bessel_return_value (Complex (yr, yi), ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
883 }
4911
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
884 else if (is_integer_value (alpha - 0.5))
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
885 {
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
886 // 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
887 alpha = -alpha;
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
888 Complex tmp = zbesj (z, alpha, kode, ierr);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
889 if ((static_cast <long> (alpha - 0.5)) & 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
890 tmp = - tmp;
4911
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
891 retval = bessel_return_value (tmp, ierr);
14027e0bafa4 [project @ 2004-07-22 19:58:06 by jwe]
jwe
parents: 4844
diff changeset
892 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
893 else
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
894 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
895 alpha = -alpha;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
896
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
897 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
898
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
899 if (ierr == 0 || ierr == 3)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
900 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
901 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
902
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
903 retval = bessel_return_value (tmp, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
904 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
905 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
906 retval = Complex (octave_NaN, octave_NaN);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
907 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
908
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
909 return retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
910 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
911
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
912 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
913 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
914 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
915 Complex retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
916
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
917 if (alpha >= 0.0)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
918 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
919 double yr = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
920 double yi = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
921
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
922 octave_idx_type nz;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
923
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
924 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
925 double zi = z.imag ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
926
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
927 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
928
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
929 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
930 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
931 double expz = exp (std::abs (zr));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
932 yr *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
933 yi *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
934 }
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
935
4490
1aed172ab84a [project @ 2003-08-28 19:03:06 by jwe]
jwe
parents: 4180
diff changeset
936 if (zi == 0.0 && zr >= 0.0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
937 yi = 0.0;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
938
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
939 retval = bessel_return_value (Complex (yr, yi), ierr);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
940 }
14196
35ce1eab7400 besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents: 14138
diff changeset
941 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
942 {
35ce1eab7400 besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents: 14138
diff changeset
943 // 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
944 alpha = -alpha;
35ce1eab7400 besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents: 14138
diff changeset
945 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
946 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
947 }
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
948 else
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
949 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
950 alpha = -alpha;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
951
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
952 Complex tmp = zbesi (z, alpha, kode, ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
953
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
954 if (ierr == 0 || ierr == 3)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
955 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
956 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
957 * zbesk (z, alpha, kode, ierr);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
958
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
959 if (kode == 2)
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 // 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
962 tmp2 *= exp (-z - std::abs (z.real ()));
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
963 }
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
964
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
965 tmp += tmp2;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
966
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
967 retval = bessel_return_value (tmp, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
968 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
969 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
970 retval = Complex (octave_NaN, octave_NaN);
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
971 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
972
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
973 return retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
974 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
975
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
976 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
977 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
978 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
979 Complex retval;
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 if (alpha >= 0.0)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
982 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
983 double yr = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
984 double yi = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
985
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
986 octave_idx_type nz;
3220
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 zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
989 double zi = z.imag ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
990
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
991 ierr = 0;
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 if (zr == 0.0 && zi == 0.0)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
994 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
995 yr = octave_Inf;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
996 yi = 0.0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
997 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
998 else
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 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
1001
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1002 if (kode != 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1003 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1004 Complex expz = exp (-z);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1005
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1006 double rexpz = real (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1007 double iexpz = imag (expz);
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 double tmp = yr*rexpz - yi*iexpz;
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 yi = yr*iexpz + yi*rexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1012 yr = tmp;
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
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1015 if (zi == 0.0 && zr >= 0.0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1016 yi = 0.0;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1017 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1018
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1019 retval = bessel_return_value (Complex (yr, yi), ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1020 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1021 else
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1022 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1023 Complex tmp = zbesk (z, -alpha, kode, ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1024
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1025 retval = bessel_return_value (tmp, ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1026 }
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1027
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1028 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1029 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1030
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1031 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1032 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
1033 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1034 Complex retval;
3146
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 if (alpha >= 0.0)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1037 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1038 double yr = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1039 double yi = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1040
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1041 octave_idx_type nz;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1042
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1043 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1044 double zi = z.imag ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1045
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1046 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
1047
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1048 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1049 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1050 Complex expz = exp (Complex (0.0, 1.0) * z);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1051
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1052 double rexpz = real (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1053 double iexpz = imag (expz);
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 double tmp = yr*rexpz - yi*iexpz;
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 yi = yr*iexpz + yi*rexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1058 yr = tmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1059 }
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1060
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1061 retval = bessel_return_value (Complex (yr, yi), ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1062 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1063 else
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1064 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1065 alpha = -alpha;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1066
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1067 static const Complex eye = Complex (0.0, 1.0);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1068
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1069 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
1070
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1071 retval = bessel_return_value (tmp, ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1072 }
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 return retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1075 }
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1076
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1077 static inline Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1078 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
1079 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1080 Complex retval;
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 if (alpha >= 0.0)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1083 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1084 double yr = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1085 double yi = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1086
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1087 octave_idx_type nz;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1088
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1089 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1090 double zi = z.imag ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1091
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1092 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
1093
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1094 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1095 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1096 Complex expz = exp (-Complex (0.0, 1.0) * z);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1097
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1098 double rexpz = real (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1099 double iexpz = imag (expz);
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 double tmp = yr*rexpz - yi*iexpz;
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 yi = yr*iexpz + yi*rexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1104 yr = tmp;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1105 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1106
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1107 retval = bessel_return_value (Complex (yr, yi), ierr);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1108 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1109 else
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1110 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1111 alpha = -alpha;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1112
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1113 static const Complex eye = Complex (0.0, 1.0);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1114
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1115 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
1116
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1117 retval = bessel_return_value (tmp, ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1118 }
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 return retval;
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
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1123 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
1124
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1125 static inline Complex
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1126 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
1127 bool scaled, octave_idx_type& ierr)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1128 {
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1129 Complex retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1130
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1131 retval = f (x, alpha, (scaled ? 2 : 1), ierr);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1132
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1133 return retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1134 }
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 static inline ComplexMatrix
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1137 do_bessel (dptr f, const char *, double alpha, const ComplexMatrix& x,
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1138 bool scaled, Array<octave_idx_type>& ierr)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1139 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1140 octave_idx_type nr = x.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1141 octave_idx_type nc = x.cols ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1142
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1143 ComplexMatrix retval (nr, nc);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1144
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1145 ierr.resize (dim_vector (nr, nc));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1146
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1147 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1148 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
1149 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
1150
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1151 return retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1152 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1153
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1154 static inline ComplexMatrix
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1155 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
1156 bool scaled, Array<octave_idx_type>& ierr)
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1157 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1158 octave_idx_type nr = alpha.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1159 octave_idx_type nc = alpha.cols ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1160
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1161 ComplexMatrix retval (nr, nc);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1162
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1163 ierr.resize (dim_vector (nr, nc));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1164
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1165 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1166 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
1167 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
1168
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1169 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1170 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1171
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1172 static inline ComplexMatrix
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1173 do_bessel (dptr f, const char *fn, const Matrix& alpha,
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1174 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
1175 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1176 ComplexMatrix retval;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1177
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1178 octave_idx_type x_nr = x.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1179 octave_idx_type x_nc = x.cols ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1180
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1181 octave_idx_type alpha_nr = alpha.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1182 octave_idx_type alpha_nc = alpha.cols ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1183
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1184 if (x_nr == alpha_nr && x_nc == alpha_nc)
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 nr = x_nr;
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1187 octave_idx_type nc = x_nc;
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 retval.resize (nr, nc);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1190
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1191 ierr.resize (dim_vector (nr, nc));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1192
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1193 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
1194 for (octave_idx_type i = 0; i < nr; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1195 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
1196 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1197 else
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1198 (*current_liboctave_error_handler)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1199 ("%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
1200
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1201 return retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1202 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1203
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1204 static inline ComplexNDArray
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1205 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
1206 bool scaled, Array<octave_idx_type>& ierr)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1207 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1208 dim_vector dv = x.dims ();
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1209 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1210 ComplexNDArray retval (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1211
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1212 ierr.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1213
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1214 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
1215 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
1216
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1217 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1218 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1219
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1220 static inline ComplexNDArray
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1221 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
1222 bool scaled, Array<octave_idx_type>& ierr)
4844
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 dim_vector dv = alpha.dims ();
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1225 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1226 ComplexNDArray retval (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1227
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1228 ierr.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1229
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1230 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
1231 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
1232
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1233 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1234 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1235
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1236 static inline ComplexNDArray
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1237 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
1238 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
1239 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1240 dim_vector dv = x.dims ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1241 ComplexNDArray retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1242
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1243 if (dv == alpha.dims ())
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1244 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1245 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1246
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1247 retval.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1248 ierr.resize (dv);
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 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
1251 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
1252 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1253 else
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1254 (*current_liboctave_error_handler)
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1255 ("%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
1256
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1257 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1258 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1259
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1260 static inline ComplexMatrix
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1261 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
1262 const ComplexColumnVector& x, bool scaled,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1263 Array<octave_idx_type>& ierr)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1264 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1265 octave_idx_type nr = x.length ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1266 octave_idx_type nc = alpha.length ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1267
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1268 ComplexMatrix retval (nr, nc);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1269
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1270 ierr.resize (dim_vector (nr, nc));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1271
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1272 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1273 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
1274 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
1275
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1276 return retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1277 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1278
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1279 #define SS_BESSEL(name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1280 Complex \
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1281 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
1282 { \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1283 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1284 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1285
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1286 #define SM_BESSEL(name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1287 ComplexMatrix \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1288 name (double alpha, const ComplexMatrix& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1289 Array<octave_idx_type>& ierr) \
3220
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 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1292 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1293
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1294 #define MS_BESSEL(name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1295 ComplexMatrix \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1296 name (const Matrix& alpha, const Complex& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1297 Array<octave_idx_type>& ierr) \
3220
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 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1300 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1301
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1302 #define MM_BESSEL(name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1303 ComplexMatrix \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1304 name (const Matrix& alpha, const ComplexMatrix& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1305 Array<octave_idx_type>& ierr) \
3220
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 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1308 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1309
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1310 #define SN_BESSEL(name, fcn) \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1311 ComplexNDArray \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1312 name (double alpha, const ComplexNDArray& x, bool scaled, \
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1313 Array<octave_idx_type>& ierr) \
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1314 { \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1315 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1316 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1317
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1318 #define NS_BESSEL(name, fcn) \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1319 ComplexNDArray \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1320 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
1321 Array<octave_idx_type>& ierr) \
4844
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 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1324 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1325
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1326 #define NN_BESSEL(name, fcn) \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1327 ComplexNDArray \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1328 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
1329 Array<octave_idx_type>& ierr) \
4844
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 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1332 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1333
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1334 #define RC_BESSEL(name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1335 ComplexMatrix \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1336 name (const RowVector& alpha, const ComplexColumnVector& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1337 Array<octave_idx_type>& ierr) \
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1338 { \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1339 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1340 }
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1341
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1342 #define ALL_BESSEL(name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1343 SS_BESSEL (name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1344 SM_BESSEL (name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1345 MS_BESSEL (name, fcn) \
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1346 MM_BESSEL (name, fcn) \
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1347 SN_BESSEL (name, fcn) \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1348 NS_BESSEL (name, fcn) \
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
1349 NN_BESSEL (name, fcn) \
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1350 RC_BESSEL (name, fcn)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1351
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1352 ALL_BESSEL (besselj, zbesj)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1353 ALL_BESSEL (bessely, zbesy)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1354 ALL_BESSEL (besseli, zbesi)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1355 ALL_BESSEL (besselk, zbesk)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1356 ALL_BESSEL (besselh1, zbesh1)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1357 ALL_BESSEL (besselh2, zbesh2)
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1358
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1359 #undef ALL_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1360 #undef SS_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1361 #undef SM_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1362 #undef MS_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1363 #undef MM_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1364 #undef SN_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1365 #undef NS_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1366 #undef NN_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1367 #undef RC_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1368
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1369 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1370 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
1371
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1372 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1373 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
1374
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1375 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1376 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
1377
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1378 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1379 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
1380
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1381 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1382 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
1383
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1384 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1385 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
1386
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1387 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1388 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
1389 {
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1390 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
1391 octave_Float_Inf);
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1392 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
1393 octave_Float_NaN);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1394
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1395 FloatComplex retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1396
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1397 switch (ierr)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1398 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1399 case 0:
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1400 case 3:
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1401 retval = val;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1402 break;
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 2:
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1405 retval = inf_val;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1406 break;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1407
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1408 default:
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1409 retval = nan_val;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1410 break;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1411 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1412
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1413 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1414 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1415
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1416 static inline bool
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1417 is_integer_value (float x)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1418 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1419 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
1420 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1421
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1422 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1423 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
1424 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1425 FloatComplex retval;
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 if (alpha >= 0.0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1428 {
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
1429 FloatComplex y = 0.0;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1430
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1431 octave_idx_type nz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1432
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
1433 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
1434
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1435 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1436 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1437 float expz = exp (std::abs (imag (z)));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1438 y *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1439 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1440
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
1441 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
1442 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
1443
b3734f1cb592 lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents: 8278
diff changeset
1444 retval = bessel_return_value (y, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1445 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1446 else if (is_integer_value (alpha))
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1447 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1448 // 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
1449 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1450 FloatComplex tmp = cbesj (z, alpha, kode, ierr);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
1451 if ((static_cast <long> (alpha)) & 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1452 tmp = - tmp;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1453 retval = bessel_return_value (tmp, ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1454 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1455 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1456 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1457 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1458
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1459 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
1460 * cbesj (z, alpha, kode, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1461
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1462 if (ierr == 0 || ierr == 3)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1463 {
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1464 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
1465 * cbesy (z, alpha, kode, ierr);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1466
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1467 retval = bessel_return_value (tmp, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1468 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1469 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1470 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
1471 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1472
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1473 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1474 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1475
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1476 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1477 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
1478 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1479 FloatComplex retval;
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 if (alpha >= 0.0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1482 {
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
1483 FloatComplex y = 0.0;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1484
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1485 octave_idx_type nz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1486
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
1487 FloatComplex w;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1488
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1489 ierr = 0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1490
8279
b3734f1cb592 lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents: 8278
diff changeset
1491 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
1492 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1493 y = FloatComplex (-octave_Float_Inf, 0.0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1494 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1495 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1496 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1497 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
1498
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1499 if (kode != 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1500 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1501 float expz = exp (std::abs (imag (z)));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1502 y *= expz;
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
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1505 if (imag (z) == 0.0 && real (z) >= 0.0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1506 y = FloatComplex (y.real (), 0.0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1507 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1508
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
1509 return bessel_return_value (y, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1510 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1511 else if (is_integer_value (alpha - 0.5))
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1512 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1513 // 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
1514 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1515 FloatComplex tmp = cbesj (z, alpha, kode, ierr);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
1516 if ((static_cast <long> (alpha - 0.5)) & 1)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1517 tmp = - tmp;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1518 retval = bessel_return_value (tmp, ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1519 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1520 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1521 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1522 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1523
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1524 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
1525 * cbesy (z, alpha, kode, ierr);
7789
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 if (ierr == 0 || ierr == 3)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1528 {
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1529 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
1530 * cbesj (z, alpha, kode, ierr);
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1531
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1532 retval = bessel_return_value (tmp, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1533 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1534 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1535 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
1536 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1537
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1538 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1539 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1540
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1541 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1542 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
1543 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1544 FloatComplex retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1545
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1546 if (alpha >= 0.0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1547 {
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
1548 FloatComplex y = 0.0;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1549
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1550 octave_idx_type nz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1551
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
1552 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
1553
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1554 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1555 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1556 float expz = exp (std::abs (real (z)));
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1557 y *= expz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1558 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1559
8279
b3734f1cb592 lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents: 8278
diff changeset
1560 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
1561 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
1562
b3734f1cb592 lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents: 8278
diff changeset
1563 retval = bessel_return_value (y, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1564 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1565 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1566 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1567 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1568
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1569 FloatComplex tmp = cbesi (z, alpha, kode, ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1570
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1571 if (ierr == 0 || ierr == 3)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1572 {
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1573 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
1574 * 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
1575 * cbesk (z, alpha, kode, ierr);
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
1576
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
1577 if (kode == 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1578 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1579 // 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
1580 tmp2 *= exp (-z - std::abs (z.real ()));
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1581 }
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1582
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1583 tmp += tmp2;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1584
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1585 retval = bessel_return_value (tmp, ierr);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1586 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1587 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1588 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
1589 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1590
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1591 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1592 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1593
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1594 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1595 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
1596 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1597 FloatComplex retval;
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 if (alpha >= 0.0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1600 {
8279
b3734f1cb592 lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents: 8278
diff changeset
1601 FloatComplex y = 0.0;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1602
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1603 octave_idx_type nz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1604
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1605 ierr = 0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1606
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
1607 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
1608 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1609 y = FloatComplex (octave_Float_Inf, 0.0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1610 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1611 else
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1612 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1613 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
1614
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1615 if (kode != 2)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1616 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1617 FloatComplex expz = exp (-z);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1618
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1619 float rexpz = real (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1620 float iexpz = imag (expz);
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 float tmp_r = real (y) * rexpz - imag (y) * iexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1623 float tmp_i = real (y) * iexpz + imag (y) * rexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1624
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1625 y = FloatComplex (tmp_r, tmp_i);
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
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1628 if (imag (z) == 0.0 && real (z) >= 0.0)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1629 y = FloatComplex (y.real (), 0.0);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1630 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1631
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
1632 retval = bessel_return_value (y, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1633 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1634 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1635 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1636 FloatComplex tmp = cbesk (z, -alpha, kode, ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1637
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1638 retval = bessel_return_value (tmp, ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1639 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1640
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1641 return retval;
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1644 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1645 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
1646 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1647 FloatComplex retval;
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 if (alpha >= 0.0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1650 {
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
1651 FloatComplex y = 0.0;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1652
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1653 octave_idx_type nz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1654
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
1655 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
1656
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1657 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1658 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1659 FloatComplex expz = exp (FloatComplex (0.0, 1.0) * z);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1660
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1661 float rexpz = real (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1662 float iexpz = imag (expz);
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 float tmp_r = real (y) * rexpz - imag (y) * iexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1665 float tmp_i = real (y) * iexpz + imag (y) * rexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1666
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1667 y = FloatComplex (tmp_r, tmp_i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1668 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1669
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
1670 retval = bessel_return_value (y, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1671 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1672 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1673 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1674 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1675
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1676 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
1677
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1678 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
1679 * cbesh1 (z, alpha, kode, ierr);
7789
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 retval = bessel_return_value (tmp, ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1682 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1683
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1684 return retval;
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1687 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1688 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
1689 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1690 FloatComplex retval;
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 if (alpha >= 0.0)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1693 {
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
1694 FloatComplex y = 0.0;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1695
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1696 octave_idx_type nz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1697
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
1698 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
1699
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1700 if (kode != 2)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1701 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1702 FloatComplex expz = exp (-FloatComplex (0.0, 1.0) * z);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1703
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1704 float rexpz = real (expz);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1705 float iexpz = imag (expz);
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 float tmp_r = real (y) * rexpz - imag (y) * iexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1708 float tmp_i = real (y) * iexpz + imag (y) * rexpz;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1709
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1710 y = FloatComplex (tmp_r, tmp_i);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1711 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1712
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
1713 retval = bessel_return_value (y, ierr);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1714 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1715 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1716 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1717 alpha = -alpha;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1718
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1719 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
1720
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1721 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
1722 * cbesh2 (z, alpha, kode, ierr);
7789
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 retval = bessel_return_value (tmp, ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1725 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1726
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1727 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1728 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1729
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1730 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
1731 octave_idx_type&);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1732
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1733 static inline FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1734 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
1735 bool scaled, octave_idx_type& ierr)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1736 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1737 FloatComplex retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1738
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1739 retval = f (x, alpha, (scaled ? 2 : 1), ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1740
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1741 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1742 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1743
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1744 static inline FloatComplexMatrix
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1745 do_bessel (fptr f, const char *, float alpha, const FloatComplexMatrix& x,
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1746 bool scaled, Array<octave_idx_type>& ierr)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1747 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1748 octave_idx_type nr = x.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1749 octave_idx_type nc = x.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1750
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1751 FloatComplexMatrix retval (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1752
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1753 ierr.resize (dim_vector (nr, nc));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1754
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1755 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
1756 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
1757 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
1758
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1759 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1760 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1761
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1762 static inline FloatComplexMatrix
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1763 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
1764 const FloatComplex& x,
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1765 bool scaled, Array<octave_idx_type>& ierr)
7789
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 octave_idx_type nr = alpha.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1768 octave_idx_type nc = alpha.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1769
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1770 FloatComplexMatrix retval (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1771
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1772 ierr.resize (dim_vector (nr, nc));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1773
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1774 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
1775 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
1776 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
1777
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1778 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1779 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1780
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1781 static inline FloatComplexMatrix
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1782 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
1783 const FloatComplexMatrix& x, bool scaled,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1784 Array<octave_idx_type>& ierr)
7789
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 FloatComplexMatrix retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1787
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1788 octave_idx_type x_nr = x.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1789 octave_idx_type x_nc = x.cols ();
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 octave_idx_type alpha_nr = alpha.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1792 octave_idx_type alpha_nc = alpha.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1793
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1794 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
1795 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1796 octave_idx_type nr = x_nr;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1797 octave_idx_type nc = x_nc;
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 retval.resize (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1800
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1801 ierr.resize (dim_vector (nr, nc));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1802
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1803 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
1804 for (octave_idx_type i = 0; i < nr; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1805 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
1806 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1807 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1808 (*current_liboctave_error_handler)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1809 ("%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
1810
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1811 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1812 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1813
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1814 static inline FloatComplexNDArray
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1815 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
1816 bool scaled, Array<octave_idx_type>& ierr)
7789
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 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1819 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1820 FloatComplexNDArray retval (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1821
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1822 ierr.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1823
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1824 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
1825 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
1826
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1827 return retval;
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1830 static inline FloatComplexNDArray
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1831 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
1832 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
1833 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1834 dim_vector dv = alpha.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1835 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1836 FloatComplexNDArray retval (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1837
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1838 ierr.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1839
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1840 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
1841 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
1842
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1843 return retval;
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1846 static inline FloatComplexNDArray
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1847 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
1848 const FloatComplexNDArray& x, bool scaled,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1849 Array<octave_idx_type>& ierr)
7789
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 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1852 FloatComplexNDArray retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1853
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1854 if (dv == alpha.dims ())
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 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1857
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1858 retval.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1859 ierr.resize (dv);
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 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
1862 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
1863 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1864 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1865 (*current_liboctave_error_handler)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1866 ("%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
1867
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1868 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1869 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1870
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1871 static inline FloatComplexMatrix
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1872 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
1873 const FloatComplexColumnVector& x, bool scaled,
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
1874 Array<octave_idx_type>& ierr)
7789
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 octave_idx_type nr = x.length ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1877 octave_idx_type nc = alpha.length ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1878
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1879 FloatComplexMatrix retval (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1880
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
1881 ierr.resize (dim_vector (nr, nc));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1882
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1883 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
1884 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
1885 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
1886
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1887 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1888 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1889
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1890 #define SS_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1891 FloatComplex \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1892 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
1893 { \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1894 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
1895 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1896
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1897 #define SM_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1898 FloatComplexMatrix \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1899 name (float alpha, const FloatComplexMatrix& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1900 Array<octave_idx_type>& ierr) \
7789
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 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
1903 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1904
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1905 #define MS_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1906 FloatComplexMatrix \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1907 name (const FloatMatrix& alpha, const FloatComplex& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1908 Array<octave_idx_type>& ierr) \
7789
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 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
1911 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1912
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1913 #define MM_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1914 FloatComplexMatrix \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1915 name (const FloatMatrix& alpha, const FloatComplexMatrix& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1916 Array<octave_idx_type>& ierr) \
7789
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 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
1919 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1920
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1921 #define SN_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1922 FloatComplexNDArray \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1923 name (float alpha, const FloatComplexNDArray& x, bool scaled, \
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
1924 Array<octave_idx_type>& ierr) \
7789
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 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
1927 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1928
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1929 #define NS_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1930 FloatComplexNDArray \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1931 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
1932 Array<octave_idx_type>& ierr) \
7789
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 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
1935 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1936
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1937 #define NN_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1938 FloatComplexNDArray \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1939 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
1940 Array<octave_idx_type>& ierr) \
7789
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 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
1943 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1944
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1945 #define RC_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1946 FloatComplexMatrix \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1947 name (const FloatRowVector& alpha, const FloatComplexColumnVector& x, bool scaled, \
10352
a3635bc1ea19 remove Array2
Jaroslav Hajek <highegg@gmail.com>
parents: 10314
diff changeset
1948 Array<octave_idx_type>& ierr) \
7789
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 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
1951 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1952
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1953 #define ALL_BESSEL(name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1954 SS_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1955 SM_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1956 MS_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1957 MM_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1958 SN_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1959 NS_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1960 NN_BESSEL (name, fcn) \
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1961 RC_BESSEL (name, fcn)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1962
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1963 ALL_BESSEL (besselj, cbesj)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1964 ALL_BESSEL (bessely, cbesy)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1965 ALL_BESSEL (besseli, cbesi)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1966 ALL_BESSEL (besselk, cbesk)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1967 ALL_BESSEL (besselh1, cbesh1)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1968 ALL_BESSEL (besselh2, cbesh2)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1969
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1970 #undef ALL_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1971 #undef SS_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1972 #undef SM_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1973 #undef MS_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1974 #undef MM_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1975 #undef SN_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1976 #undef NS_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1977 #undef NN_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1978 #undef RC_BESSEL
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
1979
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1980 Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1981 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
1982 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1983 double ar = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1984 double ai = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1985
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1986 octave_idx_type nz;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1987
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1988 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1989 double zi = z.imag ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
1990
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
1991 octave_idx_type id = deriv ? 1 : 0;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
1992
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1993 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
1994
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1995 if (! scaled)
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1996 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14847
diff changeset
1997 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
1998
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
1999 double rexpz = real (expz);
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2000 double iexpz = imag (expz);
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2001
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2002 double tmp = ar*rexpz - ai*iexpz;
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2003
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2004 ai = ar*iexpz + ai*rexpz;
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2005 ar = tmp;
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2006 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2007
4490
1aed172ab84a [project @ 2003-08-28 19:03:06 by jwe]
jwe
parents: 4180
diff changeset
2008 if (zi == 0.0 && (! scaled || zr >= 0.0))
3225
7aae2c3636a7 [project @ 1998-12-04 23:20:12 by jwe]
jwe
parents: 3220
diff changeset
2009 ai = 0.0;
7aae2c3636a7 [project @ 1998-12-04 23:20:12 by jwe]
jwe
parents: 3220
diff changeset
2010
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2011 return bessel_return_value (Complex (ar, ai), ierr);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2012 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2013
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2014 Complex
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2015 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
2016 {
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2017 double ar = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2018 double ai = 0.0;
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2019
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2020 double zr = z.real ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2021 double zi = z.imag ();
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2022
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2023 octave_idx_type id = deriv ? 1 : 0;
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2024
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2025 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
2026
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2027 if (! scaled)
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2028 {
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2029 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
2030
4506
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2031 double rexpz = real (expz);
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2032 double iexpz = imag (expz);
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 double tmp = ar*rexpz - ai*iexpz;
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2035
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2036 ai = ar*iexpz + ai*rexpz;
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2037 ar = tmp;
3c82fc8f822c [project @ 2003-09-10 13:56:57 by jwe]
jwe
parents: 4497
diff changeset
2038 }
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2039
4490
1aed172ab84a [project @ 2003-08-28 19:03:06 by jwe]
jwe
parents: 4180
diff changeset
2040 if (zi == 0.0 && (! scaled || zr >= 0.0))
3225
7aae2c3636a7 [project @ 1998-12-04 23:20:12 by jwe]
jwe
parents: 3220
diff changeset
2041 ai = 0.0;
7aae2c3636a7 [project @ 1998-12-04 23:20:12 by jwe]
jwe
parents: 3220
diff changeset
2042
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2043 return bessel_return_value (Complex (ar, ai), ierr);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2044 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2045
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2046 ComplexMatrix
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2047 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
2048 Array<octave_idx_type>& ierr)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2049 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2050 octave_idx_type nr = z.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2051 octave_idx_type nc = z.cols ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2052
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2053 ComplexMatrix retval (nr, nc);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2054
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2055 ierr.resize (dim_vector (nr, nc));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2056
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2057 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2058 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
2059 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
2060
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2061 return retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2062 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2063
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2064 ComplexMatrix
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2065 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
2066 Array<octave_idx_type>& ierr)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2067 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2068 octave_idx_type nr = z.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2069 octave_idx_type nc = z.cols ();
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2070
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2071 ComplexMatrix retval (nr, nc);
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2072
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2073 ierr.resize (dim_vector (nr, nc));
3220
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2074
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2075 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2076 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
2077 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
2078
3deb1105fbc1 [project @ 1998-11-19 00:06:30 by jwe]
jwe
parents: 3164
diff changeset
2079 return retval;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2080 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2081
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2082 ComplexNDArray
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2083 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
2084 Array<octave_idx_type>& ierr)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2085 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2086 dim_vector dv = z.dims ();
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2087 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2088 ComplexNDArray retval (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2089
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2090 ierr.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2091
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2092 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
2093 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
2094
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2095 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2096 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2097
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2098 ComplexNDArray
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2099 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
2100 Array<octave_idx_type>& ierr)
4844
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 dim_vector dv = z.dims ();
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2103 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2104 ComplexNDArray retval (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2105
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2106 ierr.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2107
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2108 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
2109 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
2110
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2111 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2112 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2113
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2114 FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2115 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
2116 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2117 float ar = 0.0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2118 float ai = 0.0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2119
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2120 octave_idx_type nz;
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 zr = z.real ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2123 float zi = z.imag ();
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 id = deriv ? 1 : 0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2126
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2127 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
2128
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2129 if (! scaled)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2130 {
15018
3d8ace26c5b4 maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents: 14847
diff changeset
2131 FloatComplex expz = exp (- static_cast<float> (2.0 / 3.0) * z * sqrt (z));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2132
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2133 float rexpz = real (expz);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2134 float iexpz = imag (expz);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2135
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2136 float tmp = ar*rexpz - ai*iexpz;
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 ai = ar*iexpz + ai*rexpz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2139 ar = tmp;
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2142 if (zi == 0.0 && (! scaled || zr >= 0.0))
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2143 ai = 0.0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2144
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2145 return bessel_return_value (FloatComplex (ar, ai), ierr);
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
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2148 FloatComplex
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2149 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
2150 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2151 float ar = 0.0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2152 float ai = 0.0;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2153
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2154 float zr = z.real ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2155 float zi = z.imag ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2156
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2157 octave_idx_type id = deriv ? 1 : 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 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
2160
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2161 if (! scaled)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2162 {
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2163 FloatComplex expz = exp (std::abs (real (static_cast<float> (2.0 / 3.0)
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2164 * z * sqrt (z))));
7789
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 float rexpz = real (expz);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2167 float iexpz = imag (expz);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2168
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2169 float tmp = ar*rexpz - ai*iexpz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2170
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2171 ai = ar*iexpz + ai*rexpz;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2172 ar = tmp;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2173 }
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 if (zi == 0.0 && (! scaled || zr >= 0.0))
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2176 ai = 0.0;
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 return bessel_return_value (FloatComplex (ar, ai), ierr);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2179 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2180
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2181 FloatComplexMatrix
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2182 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
2183 Array<octave_idx_type>& ierr)
7789
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 octave_idx_type nr = z.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2186 octave_idx_type nc = z.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2187
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2188 FloatComplexMatrix retval (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2189
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2190 ierr.resize (dim_vector (nr, nc));
7789
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 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
2193 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
2194 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
2195
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2196 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2197 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2198
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2199 FloatComplexMatrix
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2200 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
2201 Array<octave_idx_type>& ierr)
7789
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 octave_idx_type nr = z.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2204 octave_idx_type nc = z.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2205
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2206 FloatComplexMatrix retval (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2207
11574
a83bad07f7e3 attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents: 11523
diff changeset
2208 ierr.resize (dim_vector (nr, nc));
7789
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 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
2211 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
2212 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
2213
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2214 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2215 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2216
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2217 FloatComplexNDArray
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2218 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
2219 Array<octave_idx_type>& ierr)
7789
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 dim_vector dv = z.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2222 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2223 FloatComplexNDArray retval (dv);
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 ierr.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2226
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2227 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
2228 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
2229
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2230 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2231 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2232
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2233 FloatComplexNDArray
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2234 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
2235 Array<octave_idx_type>& ierr)
7789
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 dim_vector dv = z.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2238 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2239 FloatComplexNDArray retval (dv);
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 ierr.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2242
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2243 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
2244 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
2245
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2246 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2247 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2248
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2249 static void
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2250 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
2251 const dim_vector& d3)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2252 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2253 std::string d1_str = d1.str ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2254 std::string d2_str = d2.str ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2255 std::string d3_str = d3.str ();
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 (*current_liboctave_error_handler)
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2258 ("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
2259 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
2260 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2261
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2262 static void
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2263 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
2264 const dim_vector& d3)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2265 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2266 std::string d1_str = d1.str ();
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2267 std::string d2_str = d2.str ();
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2268 std::string d3_str = d3.str ();
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 (*current_liboctave_error_handler)
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2271 ("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
2272 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
2273 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
2274
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2275 double
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2276 betainc (double x, double a, double b)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2277 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2278 double retval;
5700
67118c88cee7 [project @ 2006-03-21 17:31:45 by jwe]
jwe
parents: 5307
diff changeset
2279 F77_XFCN (xdbetai, XDBETAI, (x, a, b, retval));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2280 return retval;
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
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2283 Array<double>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2284 betainc (double x, double a, const Array<double>& b)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2285 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2286 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
2287 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
2288
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2289 Array<double> retval (dv);
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2290
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2291 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
2292
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2293 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
2294 *pretval++ = betainc (x, a, b(i));
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2295
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2296 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2297 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2298
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2299 Array<double>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2300 betainc (double x, const Array<double>& a, double b)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2301 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2302 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
2303 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
2304
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2305 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
2306
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2307 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
2308
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2309 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
2310 *pretval++ = betainc (x, a(i), b);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2311
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2312 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2313 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2314
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2315 Array<double>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2316 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
2317 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2318 Array<double> retval;
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2319 dim_vector dv = a.dims ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2320
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2321 if (dv == b.dims ())
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2322 {
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2323 octave_idx_type nel = dv.numel ();
4844
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 retval.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2326
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2327 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
2328
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2329 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
2330 *pretval++ = betainc (x, a(i), b(i));
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2331 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2332 else
10258
e317791645c4 64-bit fixes
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2333 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
2334
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2335 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2336 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2337
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2338 Array<double>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2339 betainc (const Array<double>& x, double a, double b)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2340 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2341 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
2342 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
2343
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2344 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
2345
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2346 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
2347
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2348 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
2349 *pretval++ = betainc (x(i), a, b);
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2350
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2351 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2352 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2353
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2354 Array<double>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2355 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
2356 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2357 Array<double> retval;
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2358 dim_vector dv = x.dims ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2359
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2360 if (dv == b.dims ())
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2361 {
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2362 octave_idx_type nel = dv.numel ();
4844
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 retval.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2365
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2366 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
2367
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2368 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
2369 *pretval++ = betainc (x(i), a, b(i));
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2370 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2371 else
10258
e317791645c4 64-bit fixes
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2372 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
2373
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2374 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2375 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2376
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2377 Array<double>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2378 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
2379 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2380 Array<double> retval;
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2381 dim_vector dv = x.dims ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2382
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2383 if (dv == a.dims ())
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2384 {
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2385 octave_idx_type nel = dv.numel ();
4844
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 retval.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2388
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2389 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
2390
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2391 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
2392 *pretval++ = betainc (x(i), a(i), b);
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2393 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2394 else
10258
e317791645c4 64-bit fixes
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2395 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
2396
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2397 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2398 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2399
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2400 Array<double>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2401 betainc (const Array<double>& x, const Array<double>& a, const Array<double>& b)
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2402 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2403 Array<double> retval;
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2404 dim_vector dv = x.dims ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2405
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2406 if (dv == a.dims () && dv == b.dims ())
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2407 {
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2408 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2409
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2410 retval.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2411
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2412 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
2413
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2414 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
2415 *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
2416 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2417 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2418 gripe_betainc_nonconformant (dv, a.dims (), b.dims ());
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2419
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2420 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2421 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2422
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2423 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2424 betainc (float x, float a, float b)
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 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2427 F77_XFCN (xbetai, XBETAI, (x, a, b, retval));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2428 return retval;
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
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2431 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2432 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
2433 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2434 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
2435 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
2436
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2437 Array<float> retval (dv);
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2438
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2439 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
2440
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2441 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
2442 *pretval++ = betainc (x, a, b(i));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2443
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2444 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2445 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2446
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2447 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2448 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
2449 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2450 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
2451 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
2452
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2453 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
2454
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2455 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
2456
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2457 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
2458 *pretval++ = betainc (x, a(i), b);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2459
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2460 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2461 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2462
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2463 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2464 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
2465 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2466 Array<float> retval;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2467 dim_vector dv = a.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2468
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2469 if (dv == b.dims ())
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2470 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2471 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2472
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2473 retval.resize (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2474
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2475 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
2476
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2477 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
2478 *pretval++ = betainc (x, a(i), b(i));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2479 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2480 else
10258
e317791645c4 64-bit fixes
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2481 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
2482
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2483 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2484 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2485
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2486 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2487 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
2488 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2489 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
2490 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
2491
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2492 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
2493
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2494 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
2495
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2496 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
2497 *pretval++ = betainc (x(i), a, b);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2498
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2499 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2500 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2501
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2502 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2503 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
2504 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2505 Array<float> retval;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2506 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2507
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2508 if (dv == b.dims ())
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2509 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2510 octave_idx_type nel = dv.numel ();
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 retval.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2513
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2514 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
2515
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2516 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
2517 *pretval++ = betainc (x(i), a, b(i));
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2518 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2519 else
10258
e317791645c4 64-bit fixes
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2520 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
2521
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2522 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2523 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2524
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2525 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2526 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
2527 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2528 Array<float> retval;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2529 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2530
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2531 if (dv == a.dims ())
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2532 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2533 octave_idx_type nel = dv.numel ();
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 retval.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2536
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2537 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
2538
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2539 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
2540 *pretval++ = betainc (x(i), a(i), b);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2541 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2542 else
10258
e317791645c4 64-bit fixes
John W. Eaton <jwe@octave.org>
parents: 10158
diff changeset
2543 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
2544
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2545 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2546 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2547
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2548 Array<float>
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2549 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
2550 {
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2551 Array<float> retval;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2552 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2553
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2554 if (dv == a.dims () && dv == b.dims ())
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2555 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2556 octave_idx_type nel = dv.numel ();
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 retval.resize (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2559
14815
95b93a728603 Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents: 14786
diff changeset
2560 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
2561
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2562 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
2563 *pretval++ = betainc (x(i), a(i), b(i));
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2564 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2565 else
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2566 gripe_betainc_nonconformant (dv, a.dims (), b.dims ());
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2567
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2568 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2569 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2570
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2571 // FIXME: there is still room for improvement here...
3164
45490c020e47 [project @ 1998-04-14 20:56:48 by jwe]
jwe
parents: 3162
diff changeset
2572
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2573 double
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2574 gammainc (double x, double a, bool& err)
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2575 {
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2576 double retval;
3164
45490c020e47 [project @ 1998-04-14 20:56:48 by jwe]
jwe
parents: 3162
diff changeset
2577
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2578 err = false;
3164
45490c020e47 [project @ 1998-04-14 20:56:48 by jwe]
jwe
parents: 3162
diff changeset
2579
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2580 if (a < 0.0 || x < 0.0)
18831
5bd1ca29c5f0 Clean up questionable code bits identified by clang sanitize.
Rik <rik@octave.org>
parents: 18084
diff changeset
2581 (*current_liboctave_error_handler)
5bd1ca29c5f0 Clean up questionable code bits identified by clang sanitize.
Rik <rik@octave.org>
parents: 18084
diff changeset
2582 ("gammainc: A and X must be non-negative");
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2583 else
5278
fe23ec6763b7 [project @ 2005-04-12 21:04:39 by jwe]
jwe
parents: 5275
diff changeset
2584 F77_XFCN (xgammainc, XGAMMAINC, (a, x, retval));
3164
45490c020e47 [project @ 1998-04-14 20:56:48 by jwe]
jwe
parents: 3162
diff changeset
2585
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2586 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2587 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2588
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2589 Matrix
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2590 gammainc (double x, const Matrix& a)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2591 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2592 octave_idx_type nr = a.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2593 octave_idx_type nc = a.cols ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2594
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2595 Matrix result (nr, nc);
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2596 Matrix retval;
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2597
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2598 bool err;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2599
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2600 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2601 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
2602 {
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2603 result(i,j) = gammainc (x, a(i,j), err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2604
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2605 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2606 goto done;
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2607 }
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2608
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2609 retval = result;
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2610
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2611 done:
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2612
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2613 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2614 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2615
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2616 Matrix
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2617 gammainc (const Matrix& x, double a)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2618 {
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2619 octave_idx_type nr = x.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2620 octave_idx_type nc = x.cols ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2621
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2622 Matrix result (nr, nc);
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2623 Matrix retval;
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2624
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2625 bool err;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2626
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2627 for (octave_idx_type j = 0; j < nc; j++)
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2628 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
2629 {
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2630 result(i,j) = gammainc (x(i,j), a, err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2631
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2632 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2633 goto done;
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2634 }
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2635
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2636 retval = result;
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2637
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2638 done:
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2639
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2640 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2641 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2642
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2643 Matrix
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2644 gammainc (const Matrix& x, const Matrix& a)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2645 {
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2646 Matrix result;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2647 Matrix retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2648
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2649 octave_idx_type nr = x.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2650 octave_idx_type nc = x.cols ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2651
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2652 octave_idx_type a_nr = a.rows ();
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2653 octave_idx_type a_nc = a.cols ();
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2654
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2655 if (nr == a_nr && nc == a_nc)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2656 {
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2657 result.resize (nr, nc);
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2658
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2659 bool err;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2660
5275
23b37da9fd5b [project @ 2005-04-08 16:07:35 by jwe]
jwe
parents: 4911
diff changeset
2661 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
2662 for (octave_idx_type i = 0; i < nr; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2663 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2664 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
2665
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2666 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2667 goto done;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2668 }
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2669
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2670 retval = result;
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2671 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2672 else
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2673 (*current_liboctave_error_handler)
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2674 ("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
2675 nr, nc, a_nr, a_nc);
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2676
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2677 done:
4004
ca854fb51a88 [project @ 2002-07-25 06:31:33 by jwe]
jwe
parents: 3887
diff changeset
2678
3146
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2679 return retval;
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2680 }
3d5aefef14e2 [project @ 1998-02-05 20:58:44 by jwe]
jwe
parents:
diff changeset
2681
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2682 NDArray
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2683 gammainc (double x, const NDArray& a)
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2684 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2685 dim_vector dv = a.dims ();
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2686 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2687
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2688 NDArray retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2689 NDArray result (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2690
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2691 bool err;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2692
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2693 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
2694 {
18084
8e056300994b Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents: 17769
diff changeset
2695 result(i) = gammainc (x, a(i), err);
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2696
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2697 if (err)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2698 goto done;
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2699 }
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 retval = result;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2702
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2703 done:
4844
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 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2706 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2707
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2708 NDArray
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2709 gammainc (const NDArray& x, double a)
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 dim_vector dv = x.dims ();
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2712 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2713
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2714 NDArray retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2715 NDArray result (dv);
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2716
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2717 bool err;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2718
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2719 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
2720 {
18084
8e056300994b Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents: 17769
diff changeset
2721 result(i) = gammainc (x(i), a, err);
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2722
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2723 if (err)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2724 goto done;
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2725 }
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 retval = result;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2728
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2729 done:
4844
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 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2732 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2733
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2734 NDArray
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2735 gammainc (const NDArray& x, const NDArray& a)
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 dim_vector dv = x.dims ();
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2738 octave_idx_type nel = dv.numel ();
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2739
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2740 NDArray retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2741 NDArray result;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2742
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2743 if (dv == a.dims ())
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2744 {
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2745 result.resize (dv);
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 bool err;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2748
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2749 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
2750 {
18084
8e056300994b Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents: 17769
diff changeset
2751 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
2752
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2753 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2754 goto done;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2755 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2756
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2757 retval = result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2758 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2759 else
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 std::string x_str = dv.str ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2762 std::string a_str = a.dims ().str ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2763
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2764 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2765 ("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
2766 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
2767 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2768
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2769 done:
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2770
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2771 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2772 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2773
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2774 float
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2775 gammainc (float x, float a, bool& err)
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 float retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2778
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2779 err = false;
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 if (a < 0.0 || x < 0.0)
18831
5bd1ca29c5f0 Clean up questionable code bits identified by clang sanitize.
Rik <rik@octave.org>
parents: 18084
diff changeset
2782 (*current_liboctave_error_handler)
5bd1ca29c5f0 Clean up questionable code bits identified by clang sanitize.
Rik <rik@octave.org>
parents: 18084
diff changeset
2783 ("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
2784 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2785 F77_XFCN (xsgammainc, XSGAMMAINC, (a, x, retval));
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2786
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2787 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2788 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2790 FloatMatrix
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2791 gammainc (float x, const FloatMatrix& a)
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 octave_idx_type nr = a.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2794 octave_idx_type nc = a.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2795
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2796 FloatMatrix result (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2797 FloatMatrix retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2798
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2799 bool err;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2800
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2801 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
2802 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
2803 {
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2804 result(i,j) = gammainc (x, a(i,j), err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2805
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2806 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2807 goto done;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2808 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2809
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2810 retval = result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2811
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2812 done:
7789
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 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2815 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2816
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2817 FloatMatrix
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2818 gammainc (const FloatMatrix& x, float a)
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 octave_idx_type nr = x.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2821 octave_idx_type nc = x.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2822
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2823 FloatMatrix result (nr, nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2824 FloatMatrix retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2825
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2826 bool err;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2827
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2828 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
2829 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
2830 {
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2831 result(i,j) = gammainc (x(i,j), a, err);
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2832
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2833 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2834 goto done;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2835 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2836
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2837 retval = result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2838
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2839 done:
7789
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 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2842 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2843
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2844 FloatMatrix
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2845 gammainc (const FloatMatrix& x, const FloatMatrix& a)
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 FloatMatrix result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2848 FloatMatrix retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2849
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2850 octave_idx_type nr = x.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2851 octave_idx_type nc = x.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2852
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2853 octave_idx_type a_nr = a.rows ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2854 octave_idx_type a_nc = a.cols ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2855
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2856 if (nr == a_nr && nc == a_nc)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2857 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2858 result.resize (nr, nc);
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 bool err;
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 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
2863 for (octave_idx_type i = 0; i < nr; i++)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2864 {
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2865 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
2866
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2867 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2868 goto done;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2869 }
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2870
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2871 retval = result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2872 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2873 else
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2874 (*current_liboctave_error_handler)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2875 ("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
2876 nr, nc, a_nr, a_nc);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2877
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2878 done:
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2879
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2880 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2881 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2882
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2883 FloatNDArray
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2884 gammainc (float x, const FloatNDArray& a)
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 dim_vector dv = a.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2887 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2888
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2889 FloatNDArray retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2890 FloatNDArray result (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2891
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2892 bool err;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2893
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2894 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
2895 {
18084
8e056300994b Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents: 17769
diff changeset
2896 result(i) = gammainc (x, a(i), err);
7789
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 if (err)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2899 goto done;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2900 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2901
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2902 retval = result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2903
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2904 done:
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2905
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2906 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2907 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2908
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2909 FloatNDArray
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2910 gammainc (const FloatNDArray& x, float a)
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 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2913 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2914
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2915 FloatNDArray retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2916 FloatNDArray result (dv);
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2917
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2918 bool err;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2919
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2920 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
2921 {
18084
8e056300994b Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents: 17769
diff changeset
2922 result(i) = gammainc (x(i), a, err);
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2923
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2924 if (err)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2925 goto done;
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2926 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2927
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2928 retval = result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2929
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2930 done:
7789
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 return retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2933 }
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2934
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2935 FloatNDArray
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2936 gammainc (const FloatNDArray& x, const FloatNDArray& a)
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 dim_vector dv = x.dims ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2939 octave_idx_type nel = dv.numel ();
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2940
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2941 FloatNDArray retval;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2942 FloatNDArray result;
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2943
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2944 if (dv == a.dims ())
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2945 {
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents: 7638
diff changeset
2946 result.resize (dv);
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 bool err;
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 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
2951 {
18084
8e056300994b Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents: 17769
diff changeset
2952 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
2953
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2954 if (err)
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2955 goto done;
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2956 }
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2957
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2958 retval = result;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2959 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2960 else
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 std::string x_str = dv.str ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2963 std::string a_str = a.dims ().str ();
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2964
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2965 (*current_liboctave_error_handler)
10314
07ebe522dac2 untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents: 10258
diff changeset
2966 ("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
2967 x_str.c_str (), a_str.c_str ());
4844
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
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2970 done:
4844
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2971
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2972 return retval;
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2973 }
9f7ef92b50b0 [project @ 2004-04-02 17:26:53 by jwe]
jwe
parents: 4552
diff changeset
2974
9812
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2975
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2976 Complex rc_log1p (double x)
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2977 {
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2978 const double pi = 3.14159265358979323846;
19118
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
2979 return (x < -1.0
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
2980 ? Complex (gnulib::log (-(1.0 + x)), pi)
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
2981 : Complex (log1p (x)));
9812
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2982 }
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2983
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2984 FloatComplex rc_log1p (float x)
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2985 {
f80c566bc751 improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents: 9732
diff changeset
2986 const float pi = 3.14159265358979323846f;
19118
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
2987 return x < -1.0f ? FloatComplex (gnulib::logf (-(1.0f + x)), pi)
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
2988 : FloatComplex (log1pf (x));
9812
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
9838
55219e65c7cd fix typo
Jaroslav Hajek <highegg@gmail.com>
parents: 9837
diff changeset
2991 // This algorithm is due to P. J. Acklam.
9837
7c70084b125e improve comment for 9835
Jaroslav Hajek <highegg@gmail.com>
parents: 9835
diff changeset
2992 // See http://home.online.no/~pjacklam/notes/invnorm/
7c70084b125e improve comment for 9835
Jaroslav Hajek <highegg@gmail.com>
parents: 9835
diff changeset
2993 // 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
2994 // 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
2995 // 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
2996 // faster evaluation.
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
2997
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
2998 static double do_erfinv (double x, bool refine)
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
2999 {
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3000 // Coefficients of rational approximation.
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
3001 static const double a[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3002 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3003 -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
3004 -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
3005 -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
3006 };
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
3007 static const double b[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3008 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3009 -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
3010 -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
3011 -1.328068155288572e+01
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3012 };
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
3013 static const double c[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3014 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3015 -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
3016 -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
3017 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
3018 };
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
3019 static const double d[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3020 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3021 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
3022 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
3023 };
9835
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3024
14781
e190f6da40f6 maint: Correct comments and use Octave spacing conventions for erfinv.
Rik <octave@nomad.inbox5.com>
parents: 14771
diff changeset
3025 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
3026 static const double pbreak = 0.95150;
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3027 double ax = fabs (x), y;
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3028
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3029 // Select case.
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3030 if (ax <= pbreak)
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3031 {
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3032 // Middle region.
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3033 const double q = 0.5 * x, r = q*q;
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3034 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
3035 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
3036 y = yn / yd;
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3037 }
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3038 else if (ax < 1.0)
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3039 {
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3040 // Tail region.
19118
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
3041 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
3042 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
3043 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
3044 y = yn / yd * signum (-x);
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3045 }
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3046 else if (ax == 1.0)
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3047 return octave_Inf * signum (x);
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3048 else
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3049 return octave_NaN;
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 if (refine)
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3052 {
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3053 // 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
3054 double u = (erf (y) - x) * spi2 * exp (y*y);
9835
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3055 y -= u / (1 + y*u);
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3056 }
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 return y;
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3059 }
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3060
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3061 double erfinv (double x)
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 do_erfinv (x, true);
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 float erfinv (float x)
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3067 {
11586
12df7854fa7c strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents: 11574
diff changeset
3068 return do_erfinv (x, false);
9835
1bb1ed717d2f implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents: 9812
diff changeset
3069 }
10391
59e34bcdff13 implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents: 10352
diff changeset
3070
14786
e70a0c9cada6 Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14781
diff changeset
3071 // 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
3072 // 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
3073 // 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
3074
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3075 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
3076 {
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3077 // Coefficients of rational approximation.
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3078 static const double a[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3079 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3080 -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
3081 -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
3082 -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
3083 };
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3084 static const double b[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3085 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3086 -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
3087 -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
3088 -1.328068155288572e+01
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3089 };
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3090 static const double c[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3091 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3092 -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
3093 -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
3094 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
3095 };
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3096 static const double d[] =
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3097 {
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3098 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
3099 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
3100 };
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3101
14771
10ed11922f19 maint: code cleanup for new erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14770
diff changeset
3102 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
3103 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
3104 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
3105 double y;
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3106
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3107 // Select case.
14786
e70a0c9cada6 Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14781
diff changeset
3108 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
3109 {
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3110 // Middle region.
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3111 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
3112 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
3113 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
3114 y = yn / yd;
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3115 }
14786
e70a0c9cada6 Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14781
diff changeset
3116 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
3117 {
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3118 // Tail region.
19118
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
3119 const double q = x < 1 ? sqrt (-2*gnulib::log (0.5*x)) : sqrt (-2*gnulib::log (0.5*(2-x)));
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3120 const double yn = ((((c[0]*q + c[1])*q + c[2])*q + c[3])*q + c[4])*q + c[5];
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3121 const double yd = (((d[0]*q + d[1])*q + d[2])*q + d[3])*q + 1.0;
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3122 y = yn / yd;
14786
e70a0c9cada6 Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14781
diff changeset
3123 if (x < pbreak_lo)
e70a0c9cada6 Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents: 14781
diff changeset
3124 y = -y;
14770
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3125 }
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3126 else if (x == 0.0)
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3127 return octave_Inf;
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3128 else if (x == 2.0)
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3129 return -octave_Inf;
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3130 else
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3131 return octave_NaN;
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3132
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3133 if (refine)
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3134 {
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3135 // 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
3136 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
3137 y -= u / (1 + y*u);
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3138 }
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3139
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3140 return y;
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3141 }
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3142
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3143 double erfcinv (double x)
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3144 {
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3145 return do_erfcinv (x, true);
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3146 }
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3147
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3148 float erfcinv (float x)
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 return do_erfcinv (x, false);
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3151 }
cb85e836d035 New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14197
diff changeset
3152
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3153 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3154 // Incomplete Beta function ratio
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3155 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3156 // 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
3157 // 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
3158 //
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3159 // 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
3160 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3161 // Reference:
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3162 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3163 // KL Majumder, GP Bhattacharjee,
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3164 // Algorithm AS 63:
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3165 // The incomplete Beta Integral,
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3166 // Applied Statistics,
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3167 // 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
3168 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3169 double
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3170 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
3171 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3172 double acu = 0.1E-14, ai, cx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3173 bool indx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3174 int ns;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3175 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
3176
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3177 value = x;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3178 err = false;
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 // Check the input arguments.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3181
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3182 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
3183 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3184 err = true;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3185 return value;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3186 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3187
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3188 // Special cases.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3189
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3190 if (x == 0.0 || x == 1.0)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3191 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3192 return value;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3193 }
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 // Change tail if necessary and determine S.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3196
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3197 psq = p + q;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3198 cx = 1.0 - x;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3199
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3200 if (p < psq * x)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3201 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3202 xx = cx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3203 cx = x;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3204 pp = q;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3205 qq = p;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3206 indx = true;
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 else
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3209 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3210 xx = x;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3211 pp = p;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3212 qq = q;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3213 indx = false;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3214 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3215
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3216 term = 1.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3217 ai = 1.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3218 value = 1.0;
15217
d2220c3def3f avoid C-style cast warning
John W. Eaton <jwe@octave.org>
parents: 15084
diff changeset
3219 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
3220
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3221 // Use the Soper reduction formula.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3222
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3223 rx = xx / cx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3224 temp = qq - ai;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3225 if (ns == 0)
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 rx = xx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3228 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3229
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3230 for ( ; ; )
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 term = term * temp * rx / (pp + ai);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3233 value = value + term;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3234 temp = fabs (term);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3235
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3236 if (temp <= acu && temp <= acu * value)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3237 {
19118
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
3238 value = value * exp (pp * gnulib::log (xx)
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
3239 + (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
3240
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3241 if (indx)
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 value = 1.0 - value;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3244 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3245 break;
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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3248 ai = ai + 1.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3249 ns = ns - 1;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3250
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3251 if (0 <= ns)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3252 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3253 temp = qq - ai;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3254 if (ns == 0)
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 rx = xx;
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 else
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3260 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3261 temp = psq;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3262 psq = psq + 1.0;
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 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3265
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3266 return value;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3267 }
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 // Inverse of the incomplete Beta function
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 // 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
3273 // 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
3274 //
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3275 // 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
3276 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3277 // Reference:
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 // GW Cran, KJ Martin, GE Thomas,
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3280 // Remark AS R19 and Algorithm AS 109:
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3281 // 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
3282 // 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
3283 // Applied Statistics,
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3284 // 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
3285 //
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3286 double
15217
d2220c3def3f avoid C-style cast warning
John W. Eaton <jwe@octave.org>
parents: 15084
diff changeset
3287 betaincinv (double y, double p, double q)
d2220c3def3f avoid C-style cast warning
John W. Eaton <jwe@octave.org>
parents: 15084
diff changeset
3288 {
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3289 double a, acu, adj, fpu, g, h;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3290 int iex;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3291 bool indx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3292 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
3293
14847
bcf86cc2f1ee Use xlgamma instead of lgamma in betaincinv for portability across systems.
Rik <octave@nomad.inbox5.com>
parents: 14846
diff changeset
3294 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
3295 bool err = false;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3296 fpu = pow (10.0, sae);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3297 value = y;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3298
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3299 // Test for admissibility of parameters.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3300
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3301 if (p <= 0.0 || q <= 0.0)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3302 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3303 (*current_liboctave_error_handler)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3304 ("betaincinv: wrong parameters");
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3305 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3306
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3307 if (y < 0.0 || 1.0 < y)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3308 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3309 (*current_liboctave_error_handler)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3310 ("betaincinv: wrong parameter Y");
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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3313 if (y == 0.0 || y == 1.0)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3314 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3315 return value;
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 // Change tail if necessary.
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 if (0.5 < y)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3321 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3322 a = 1.0 - y;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3323 pp = q;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3324 qq = p;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3325 indx = true;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3326 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3327 else
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 a = y;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3330 pp = p;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3331 qq = q;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3332 indx = false;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3333 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3334
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3335 // Calculate the initial approximation.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3336
19118
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
3337 r = sqrt (- gnulib::log (a * a));
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3338
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3339 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
3340
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3341 if (1.0 < pp && 1.0 < qq)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3342 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3343 r = (ycur * ycur - 3.0) / 6.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3344 s = 1.0 / (pp + pp - 1.0);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3345 t = 1.0 / (qq + qq - 1.0);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3346 h = 2.0 / (s + t);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3347 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
3348 value = pp / (pp + qq * exp (w + w));
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 else
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 r = qq + qq;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3353 t = 1.0 / (9.0 * qq);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3354 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
3355
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3356 if (t <= 0.0)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3357 {
19118
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
3358 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
3359 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3360 else
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3361 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3362 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
3363
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3364 if (t <= 1.0)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3365 {
19118
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
3366 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
3367 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3368 else
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3369 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3370 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
3371 }
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 }
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 // 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
3376 // using the function BETAIN.
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3377
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3378 r = 1.0 - pp;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3379 t = 1.0 - qq;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3380 yprev = 0.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3381 sq = 1.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3382 prev = 1.0;
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 if (value < 0.0001)
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 value = 0.0001;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3387 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3388
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3389 if (0.9999 < value)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3390 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3391 value = 0.9999;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3392 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3393
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3394 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
3395
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3396 acu = pow (10.0, iex);
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3397
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3398 for ( ; ; )
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 ycur = betain (value, pp, qq, beta, err);
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 if (err)
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 return value;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3405 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3406
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3407 xin = value;
19118
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
3408 ycur = (ycur - a) * exp (beta + r * gnulib::log (xin)
161ebb78ac1b use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents: 18833
diff changeset
3409 + t * gnulib::log (1.0 - xin));
14816
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 if (ycur * yprev <= 0.0)
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 prev = std::max (sq, fpu);
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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3416 g = 1.0;
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 for ( ; ; )
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3419 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3420 for ( ; ; )
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 adj = g * ycur;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3423 sq = adj * adj;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3424
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3425 if (sq < prev)
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 tx = value - adj;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3428
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3429 if (0.0 <= tx && tx <= 1.0)
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 break;
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 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3434 g = g / 3.0;
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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3437 if (prev <= acu)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3438 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3439 if (indx)
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3440 {
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3441 value = 1.0 - value;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3442 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3443 return value;
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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3446 if (ycur * ycur <= acu)
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 (indx)
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 value = 1.0 - value;
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 return 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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3455 if (tx != 0.0 && tx != 1.0)
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 break;
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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3460 g = g / 3.0;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3461 }
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 if (tx == 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 break;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3466 }
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 value = tx;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3469 yprev = ycur;
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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3472 if (indx)
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 value = 1.0 - 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
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3477 return value;
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
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3480 Array<double>
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3481 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
3482 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3483 dim_vector dv = b.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3484 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3485
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3486 Array<double> retval (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3487
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3488 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3489
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3490 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
3491 *pretval++ = betaincinv (x, a, b(i));
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3492
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3493 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3494 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3495
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3496 Array<double>
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3497 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
3498 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3499 dim_vector dv = a.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3500 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3501
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3502 Array<double> retval (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3503
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3504 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3505
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3506 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
3507 *pretval++ = betaincinv (x, a(i), b);
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3508
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3509 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3510 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3511
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3512 Array<double>
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3513 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
3514 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3515 Array<double> retval;
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3516 dim_vector dv = a.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3517
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3518 if (dv == b.dims ())
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3519 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3520 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3521
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3522 retval.resize (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3523
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3524 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3525
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3526 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
3527 *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
3528 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3529 else
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3530 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
3531
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3532 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3533 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3534
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3535 Array<double>
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3536 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
3537 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3538 dim_vector dv = x.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3539 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3540
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3541 Array<double> retval (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3542
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3543 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3544
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3545 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
3546 *pretval++ = betaincinv (x(i), a, b);
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3547
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3548 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3549 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3550
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3551 Array<double>
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3552 betaincinv (const Array<double>& x, double a, const Array<double>& b)
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3553 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3554 Array<double> retval;
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3555 dim_vector dv = x.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3556
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3557 if (dv == b.dims ())
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3558 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3559 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3560
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3561 retval.resize (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3562
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3563 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3564
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3565 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
3566 *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
3567 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3568 else
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3569 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
3570
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3571 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3572 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3573
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3574 Array<double>
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3575 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
3576 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3577 Array<double> retval;
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3578 dim_vector dv = x.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3579
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3580 if (dv == a.dims ())
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3581 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3582 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3583
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3584 retval.resize (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3585
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3586 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3587
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3588 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
3589 *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
3590 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3591 else
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3592 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
3593
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3594 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3595 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3596
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3597 Array<double>
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3598 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
3599 const Array<double>& b)
14816
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3600 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3601 Array<double> retval;
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3602 dim_vector dv = x.dims ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3603
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3604 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
3605 {
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3606 octave_idx_type nel = dv.numel ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3607
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3608 retval.resize (dv);
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3609
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3610 double *pretval = retval.fortran_vec ();
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3611
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3612 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
3613 *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
3614 }
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3615 else
14817
67897baaa05f Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents: 14816
diff changeset
3616 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
3617
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3618 return retval;
0a868d90436b New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents: 14815
diff changeset
3619 }
17502
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3620
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3621 void
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3622 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
3623 {
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3624 static const int Nmax = 16;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3625 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
3626 int n, Nn, ii;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3627
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3628 if (m < 0 || m > 1)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3629 {
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3630 (*current_liboctave_warning_handler)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3631 ("ellipj: expecting 0 <= M <= 1");
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3632 sn = cn = dn = lo_ieee_nan_value ();
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3633 return;
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
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3636 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
3637 if (m < sqrt_eps)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3638 {
18833
6113e0c6920b maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents: 18831
diff changeset
3639 // 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
3640 si_u = sin (u);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3641 co_u = cos (u);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3642 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
3643 sn = si_u - t * co_u;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3644 cn = co_u + t * si_u;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3645 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
3646 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3647 else if ((1 - m) < sqrt_eps)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3648 {
18833
6113e0c6920b maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents: 18831
diff changeset
3649 // 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
3650 m1 = 1 - m;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3651 si_u = sinh (u);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3652 co_u = cosh (u);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3653 ta_u = tanh (u);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3654 se_u = 1/co_u;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3655 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
3656 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
3657 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
3658 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3659 else
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3660 {
18833
6113e0c6920b maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents: 18831
diff changeset
3661 // Arithmetic-Geometric Mean (AGM) algorithm
6113e0c6920b maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents: 18831
diff changeset
3662 // (Abramowitz and Stegun, Section 16.4)
17502
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3663 a[0] = 1;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3664 b = sqrt (1 - m);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3665 c[0] = sqrt (m);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3666 for (n = 1; n < Nmax; ++n)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3667 {
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3668 a[n] = (a[n - 1] + b)/2;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3669 c[n] = (a[n - 1] - b)/2;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3670 b = sqrt (a[n - 1]*b);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3671 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
3672 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3673 if (n >= Nmax - 1)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3674 {
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3675 err = 1;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3676 return;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3677 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3678 Nn = n;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3679 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
3680 phi = ii*a[Nn]*u;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3681 for (n = Nn; n > 0; --n)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3682 {
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3683 t = phi;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3684 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
3685 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3686 sn = sin (phi);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3687 cn = cos (phi);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3688 dn = cn/cos (t - phi);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3689 }
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
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3692 void
17769
49a5a4be04a1 maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents: 17744
diff changeset
3693 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
3694 double& err)
17502
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 double m1 = 1 - m, ss1, cc1, dd1;
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 ellipj (imag (u), m1, ss1, cc1, dd1, err);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3699 if (real (u) == 0)
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3700 {
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3701 // u is pure imag: Jacoby imag. transf.
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3702 sn = Complex (0, ss1/cc1);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3703 cn = 1/cc1; // cn.imag = 0;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3704 dn = dd1/cc1; // dn.imag = 0;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3705 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3706 else
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 // u is generic complex
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3709 double ss, cc, dd, ddd;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3710
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3711 ellipj (real (u), m, ss, cc, dd, err);
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3712 ddd = cc1*cc1 + m*ss*ss*ss1*ss1;
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3713 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
3714 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
3715 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
3716 }
578805a293e5 ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents: 15852
diff changeset
3717 }