annotate liboctave/lo-specfun.cc @ 10391:59e34bcdff13

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