Mercurial > hg > octave-lyh
annotate liboctave/CMatrix.cc @ 10314:07ebe522dac2
untabify liboctave C++ sources
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Thu, 11 Feb 2010 12:23:32 -0500 |
parents | f7ba6cfe7fb7 |
children | 12884915a8e4 |
rev | line source |
---|---|
1993 | 1 // Matrix manipulations. |
458 | 2 /* |
3 | |
7017 | 4 Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, |
5 2003, 2004, 2005, 2006, 2007 John W. Eaton | |
8920 | 6 Copyright (C) 2008, 2009 Jaroslav Hajek |
9601
a9b37bae1802
add a couple of missing copyright statements
Jaroslav Hajek <highegg@gmail.com>
parents:
9578
diff
changeset
|
7 Copyright (C) 2009 VZLU Prague, a.s. |
458 | 8 |
9 This file is part of Octave. | |
10 | |
11 Octave is free software; you can redistribute it and/or modify it | |
12 under the terms of the GNU General Public License as published by the | |
7016 | 13 Free Software Foundation; either version 3 of the License, or (at your |
14 option) any later version. | |
458 | 15 |
16 Octave is distributed in the hope that it will be useful, but WITHOUT | |
17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
18 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
19 for more details. | |
20 | |
21 You should have received a copy of the GNU General Public License | |
7016 | 22 along with Octave; see the file COPYING. If not, see |
23 <http://www.gnu.org/licenses/>. | |
458 | 24 |
25 */ | |
26 | |
27 #ifdef HAVE_CONFIG_H | |
1192 | 28 #include <config.h> |
458 | 29 #endif |
30 | |
1367 | 31 #include <cfloat> |
32 | |
3503 | 33 #include <iostream> |
6209 | 34 #include <vector> |
1367 | 35 |
5775 | 36 // FIXME |
2443 | 37 #include <sys/types.h> |
458 | 38 |
4669 | 39 #include "Array-util.h" |
2828 | 40 #include "CMatrix.h" |
1819 | 41 #include "CmplxAEPBAL.h" |
9523
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
42 #include "CmplxCHOL.h" |
1819 | 43 #include "CmplxSCHUR.h" |
740 | 44 #include "CmplxSVD.h" |
9523
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
45 #include "DET.h" |
1847 | 46 #include "f77-fcn.h" |
7503
8c32f95c2639
convert mapper functions to new format
David Bateman <dbateman@free.fr>
parents:
7488
diff
changeset
|
47 #include "functor.h" |
458 | 48 #include "lo-error.h" |
2354 | 49 #include "lo-ieee.h" |
50 #include "lo-mappers.h" | |
1968 | 51 #include "lo-utils.h" |
1367 | 52 #include "mx-base.h" |
2828 | 53 #include "mx-cm-dm.h" |
9523
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
54 #include "mx-cm-s.h" |
3176 | 55 #include "mx-dm-cm.h" |
1367 | 56 #include "mx-inlines.cc" |
8774
b756ce0002db
split implementation and interface in mx-op-defs and MArray-defs
Jaroslav Hajek <highegg@gmail.com>
parents:
8743
diff
changeset
|
57 #include "mx-op-defs.h" |
1650 | 58 #include "oct-cmplx.h" |
9523
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
59 #include "oct-fftw.h" |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
60 #include "oct-locbuf.h" |
8336
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
61 #include "oct-norm.h" |
458 | 62 |
63 // Fortran functions we call. | |
64 | |
65 extern "C" | |
66 { | |
7477 | 67 F77_RET_T |
68 F77_FUNC (xilaenv, XILAENV) (const octave_idx_type&, F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
69 F77_CONST_CHAR_ARG_DECL, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
70 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
71 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
72 octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
73 F77_CHAR_ARG_LEN_DECL F77_CHAR_ARG_LEN_DECL); |
7476 | 74 |
4552 | 75 F77_RET_T |
76 F77_FUNC (zgebal, ZGEBAL) (F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
77 const octave_idx_type&, Complex*, const octave_idx_type&, octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
78 octave_idx_type&, double*, octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
79 F77_CHAR_ARG_LEN_DECL); |
4552 | 80 |
81 F77_RET_T | |
82 F77_FUNC (dgebak, DGEBAK) (F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
83 F77_CONST_CHAR_ARG_DECL, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
84 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:
10213
diff
changeset
|
85 const octave_idx_type&, double*, const octave_idx_type&, octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
86 F77_CHAR_ARG_LEN_DECL |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
87 F77_CHAR_ARG_LEN_DECL); |
4552 | 88 |
89 F77_RET_T | |
90 F77_FUNC (zgemm, ZGEMM) (F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
91 F77_CONST_CHAR_ARG_DECL, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
92 const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
93 const Complex&, const Complex*, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
94 const Complex*, const octave_idx_type&, const Complex&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
95 Complex*, const octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
96 F77_CHAR_ARG_LEN_DECL |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
97 F77_CHAR_ARG_LEN_DECL); |
4552 | 98 |
99 F77_RET_T | |
5983 | 100 F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL, |
101 const octave_idx_type&, const octave_idx_type&, const Complex&, | |
102 const Complex*, const octave_idx_type&, const Complex*, | |
103 const octave_idx_type&, const Complex&, Complex*, const octave_idx_type& | |
104 F77_CHAR_ARG_LEN_DECL); | |
105 | |
106 F77_RET_T | |
107 F77_FUNC (xzdotu, XZDOTU) (const octave_idx_type&, const Complex*, const octave_idx_type&, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
108 const Complex*, const octave_idx_type&, Complex&); |
5983 | 109 |
110 F77_RET_T | |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
111 F77_FUNC (xzdotc, XZDOTC) (const octave_idx_type&, const Complex*, const octave_idx_type&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
112 const Complex*, const octave_idx_type&, Complex&); |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
113 |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
114 F77_RET_T |
7801
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
115 F77_FUNC (zsyrk, ZSYRK) (F77_CONST_CHAR_ARG_DECL, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
116 F77_CONST_CHAR_ARG_DECL, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
117 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
118 const Complex&, const Complex*, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
119 const Complex&, Complex*, const octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
120 F77_CHAR_ARG_LEN_DECL |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
121 F77_CHAR_ARG_LEN_DECL); |
7801
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
122 |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
123 F77_RET_T |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
124 F77_FUNC (zherk, ZHERK) (F77_CONST_CHAR_ARG_DECL, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
125 F77_CONST_CHAR_ARG_DECL, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
126 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
127 const double&, const Complex*, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
128 const double&, Complex*, const octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
129 F77_CHAR_ARG_LEN_DECL |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
130 F77_CHAR_ARG_LEN_DECL); |
7801
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
131 |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
132 F77_RET_T |
5275 | 133 F77_FUNC (zgetrf, ZGETRF) (const octave_idx_type&, const octave_idx_type&, Complex*, const octave_idx_type&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
134 octave_idx_type*, octave_idx_type&); |
4552 | 135 |
136 F77_RET_T | |
137 F77_FUNC (zgetrs, ZGETRS) (F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
138 const octave_idx_type&, const octave_idx_type&, Complex*, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
139 const octave_idx_type*, Complex*, const octave_idx_type&, octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
140 F77_CHAR_ARG_LEN_DECL); |
4552 | 141 |
142 F77_RET_T | |
5275 | 143 F77_FUNC (zgetri, ZGETRI) (const octave_idx_type&, Complex*, const octave_idx_type&, const octave_idx_type*, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
144 Complex*, const octave_idx_type&, octave_idx_type&); |
4552 | 145 |
146 F77_RET_T | |
147 F77_FUNC (zgecon, ZGECON) (F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
148 const octave_idx_type&, Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
149 const octave_idx_type&, const double&, double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
150 Complex*, double*, octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
151 F77_CHAR_ARG_LEN_DECL); |
4552 | 152 |
153 F77_RET_T | |
7072 | 154 F77_FUNC (zgelsy, ZGELSY) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
155 Complex*, const octave_idx_type&, Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
156 const octave_idx_type&, octave_idx_type*, double&, octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
157 Complex*, const octave_idx_type&, double*, octave_idx_type&); |
7072 | 158 |
159 F77_RET_T | |
160 F77_FUNC (zgelsd, ZGELSD) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
161 Complex*, const octave_idx_type&, Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
162 const octave_idx_type&, double*, double&, octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
163 Complex*, const octave_idx_type&, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
164 octave_idx_type*, octave_idx_type&); |
458 | 165 |
5785 | 166 F77_RET_T |
167 F77_FUNC (zpotrf, ZPOTRF) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
168 Complex*, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
169 octave_idx_type& F77_CHAR_ARG_LEN_DECL); |
5785 | 170 |
171 F77_RET_T | |
172 F77_FUNC (zpocon, ZPOCON) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
173 Complex*, const octave_idx_type&, const double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
174 double&, Complex*, double*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
175 octave_idx_type& F77_CHAR_ARG_LEN_DECL); |
5785 | 176 |
177 F77_RET_T | |
178 F77_FUNC (zpotrs, ZPOTRS) (F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
179 const octave_idx_type&, const Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
180 const octave_idx_type&, Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
181 const octave_idx_type&, octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
182 F77_CHAR_ARG_LEN_DECL); |
5785 | 183 |
184 F77_RET_T | |
6207 | 185 F77_FUNC (ztrtri, ZTRTRI) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
186 const octave_idx_type&, const Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
187 const octave_idx_type&, octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
188 F77_CHAR_ARG_LEN_DECL |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
189 F77_CHAR_ARG_LEN_DECL); |
6207 | 190 |
191 F77_RET_T | |
5785 | 192 F77_FUNC (ztrcon, ZTRCON) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
193 F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
194 const Complex*, const octave_idx_type&, double&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
195 Complex*, double*, octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
196 F77_CHAR_ARG_LEN_DECL |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
197 F77_CHAR_ARG_LEN_DECL |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
198 F77_CHAR_ARG_LEN_DECL); |
5785 | 199 |
200 F77_RET_T | |
201 F77_FUNC (ztrtrs, ZTRTRS) (F77_CONST_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
202 F77_CONST_CHAR_ARG_DECL, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
203 const octave_idx_type&, const Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
204 const octave_idx_type&, Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
205 const octave_idx_type&, octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
206 F77_CHAR_ARG_LEN_DECL |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
207 F77_CHAR_ARG_LEN_DECL |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
208 F77_CHAR_ARG_LEN_DECL); |
5785 | 209 |
4552 | 210 F77_RET_T |
211 F77_FUNC (zlartg, ZLARTG) (const Complex&, const Complex&, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
212 double&, Complex&, Complex&); |
4552 | 213 |
214 F77_RET_T | |
215 F77_FUNC (ztrsyl, ZTRSYL) (F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
216 F77_CONST_CHAR_ARG_DECL, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
217 const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
218 const Complex*, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
219 const Complex*, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
220 const Complex*, const octave_idx_type&, double&, octave_idx_type& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
221 F77_CHAR_ARG_LEN_DECL |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
222 F77_CHAR_ARG_LEN_DECL); |
4552 | 223 |
224 F77_RET_T | |
225 F77_FUNC (xzlange, XZLANGE) (F77_CONST_CHAR_ARG_DECL, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
226 const octave_idx_type&, const octave_idx_type&, const Complex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
227 const octave_idx_type&, double*, double& |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
228 F77_CHAR_ARG_LEN_DECL); |
458 | 229 } |
230 | |
2354 | 231 static const Complex Complex_NaN_result (octave_NaN, octave_NaN); |
232 | |
1360 | 233 // Complex Matrix class |
458 | 234 |
235 ComplexMatrix::ComplexMatrix (const Matrix& a) | |
1214 | 236 : MArray2<Complex> (a.rows (), a.cols ()) |
458 | 237 { |
5275 | 238 for (octave_idx_type j = 0; j < cols (); j++) |
239 for (octave_idx_type i = 0; i < rows (); i++) | |
458 | 240 elem (i, j) = a.elem (i, j); |
241 } | |
242 | |
2349 | 243 ComplexMatrix::ComplexMatrix (const RowVector& rv) |
244 : MArray2<Complex> (1, rv.length (), 0.0) | |
245 { | |
5275 | 246 for (octave_idx_type i = 0; i < rv.length (); i++) |
2349 | 247 elem (0, i) = rv.elem (i); |
248 } | |
249 | |
250 ComplexMatrix::ComplexMatrix (const ColumnVector& cv) | |
251 : MArray2<Complex> (cv.length (), 1, 0.0) | |
252 { | |
5275 | 253 for (octave_idx_type i = 0; i < cv.length (); i++) |
2349 | 254 elem (i, 0) = cv.elem (i); |
255 } | |
256 | |
458 | 257 ComplexMatrix::ComplexMatrix (const DiagMatrix& a) |
1214 | 258 : MArray2<Complex> (a.rows (), a.cols (), 0.0) |
458 | 259 { |
5275 | 260 for (octave_idx_type i = 0; i < a.length (); i++) |
458 | 261 elem (i, i) = a.elem (i, i); |
262 } | |
263 | |
2349 | 264 ComplexMatrix::ComplexMatrix (const ComplexRowVector& rv) |
8614
5114ea5a41b5
use shallow copying in Matrix/RowVector/ColumnVector conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8392
diff
changeset
|
265 : MArray2<Complex> (Array2<Complex> (rv, 1, rv.length ())) |
2349 | 266 { |
267 } | |
268 | |
269 ComplexMatrix::ComplexMatrix (const ComplexColumnVector& cv) | |
8614
5114ea5a41b5
use shallow copying in Matrix/RowVector/ColumnVector conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8392
diff
changeset
|
270 : MArray2<Complex> (Array2<Complex> (cv, cv.length (), 1)) |
2349 | 271 { |
272 } | |
273 | |
458 | 274 ComplexMatrix::ComplexMatrix (const ComplexDiagMatrix& a) |
1214 | 275 : MArray2<Complex> (a.rows (), a.cols (), 0.0) |
458 | 276 { |
5275 | 277 for (octave_idx_type i = 0; i < a.length (); i++) |
458 | 278 elem (i, i) = a.elem (i, i); |
279 } | |
280 | |
5775 | 281 // FIXME -- could we use a templated mixed-type copy function |
1574 | 282 // here? |
283 | |
2828 | 284 ComplexMatrix::ComplexMatrix (const boolMatrix& a) |
3180 | 285 : MArray2<Complex> (a.rows (), a.cols (), 0.0) |
2828 | 286 { |
5275 | 287 for (octave_idx_type i = 0; i < a.rows (); i++) |
288 for (octave_idx_type j = 0; j < a.cols (); j++) | |
2828 | 289 elem (i, j) = a.elem (i, j); |
290 } | |
291 | |
1574 | 292 ComplexMatrix::ComplexMatrix (const charMatrix& a) |
3180 | 293 : MArray2<Complex> (a.rows (), a.cols (), 0.0) |
1574 | 294 { |
5275 | 295 for (octave_idx_type i = 0; i < a.rows (); i++) |
296 for (octave_idx_type j = 0; j < a.cols (); j++) | |
8956
d91fa4b20bbb
ensure nonnegative char -> real conversion
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
297 elem (i, j) = static_cast<unsigned char> (a.elem (i, j)); |
1574 | 298 } |
299 | |
9663
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
300 ComplexMatrix::ComplexMatrix (const Matrix& re, const Matrix& im) |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
301 : MArray2<Complex> (re.rows (), re.cols ()) |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
302 { |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
303 if (im.rows () != rows () || im.cols () != cols ()) |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
304 (*current_liboctave_error_handler) ("complex: internal error"); |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
305 |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
306 octave_idx_type nel = numel (); |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
307 for (octave_idx_type i = 0; i < nel; i++) |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
308 xelem (i) = Complex (re(i), im(i)); |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
309 } |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
310 |
2384 | 311 bool |
458 | 312 ComplexMatrix::operator == (const ComplexMatrix& a) const |
313 { | |
314 if (rows () != a.rows () || cols () != a.cols ()) | |
2384 | 315 return false; |
458 | 316 |
9550
3d6a9aea2aea
refactor binary & bool ops in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9528
diff
changeset
|
317 return mx_inline_equal (length (), data (), a.data ()); |
458 | 318 } |
319 | |
2384 | 320 bool |
458 | 321 ComplexMatrix::operator != (const ComplexMatrix& a) const |
322 { | |
323 return !(*this == a); | |
324 } | |
325 | |
2815 | 326 bool |
327 ComplexMatrix::is_hermitian (void) const | |
328 { | |
5275 | 329 octave_idx_type nr = rows (); |
330 octave_idx_type nc = cols (); | |
2815 | 331 |
332 if (is_square () && nr > 0) | |
333 { | |
5275 | 334 for (octave_idx_type i = 0; i < nr; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
335 for (octave_idx_type j = i; j < nc; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
336 if (elem (i, j) != conj (elem (j, i))) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
337 return false; |
2815 | 338 |
339 return true; | |
340 } | |
341 | |
342 return false; | |
343 } | |
344 | |
458 | 345 // destructive insert/delete/reorder operations |
346 | |
347 ComplexMatrix& | |
5275 | 348 ComplexMatrix::insert (const Matrix& a, octave_idx_type r, octave_idx_type c) |
458 | 349 { |
5275 | 350 octave_idx_type a_nr = a.rows (); |
351 octave_idx_type a_nc = a.cols (); | |
1699 | 352 |
353 if (r < 0 || r + a_nr > rows () || c < 0 || c + a_nc > cols ()) | |
458 | 354 { |
355 (*current_liboctave_error_handler) ("range error for insert"); | |
356 return *this; | |
357 } | |
358 | |
4316 | 359 if (a_nr >0 && a_nc > 0) |
360 { | |
361 make_unique (); | |
362 | |
5275 | 363 for (octave_idx_type j = 0; j < a_nc; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
364 for (octave_idx_type i = 0; i < a_nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
365 xelem (r+i, c+j) = a.elem (i, j); |
4316 | 366 } |
458 | 367 |
368 return *this; | |
369 } | |
370 | |
371 ComplexMatrix& | |
5275 | 372 ComplexMatrix::insert (const RowVector& a, octave_idx_type r, octave_idx_type c) |
458 | 373 { |
5275 | 374 octave_idx_type a_len = a.length (); |
4316 | 375 |
1699 | 376 if (r < 0 || r >= rows () || c < 0 || c + a_len > cols ()) |
458 | 377 { |
378 (*current_liboctave_error_handler) ("range error for insert"); | |
379 return *this; | |
380 } | |
381 | |
4316 | 382 if (a_len > 0) |
383 { | |
384 make_unique (); | |
385 | |
5275 | 386 for (octave_idx_type i = 0; i < a_len; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
387 xelem (r, c+i) = a.elem (i); |
4316 | 388 } |
458 | 389 |
390 return *this; | |
391 } | |
392 | |
393 ComplexMatrix& | |
5275 | 394 ComplexMatrix::insert (const ColumnVector& a, octave_idx_type r, octave_idx_type c) |
458 | 395 { |
5275 | 396 octave_idx_type a_len = a.length (); |
4316 | 397 |
1699 | 398 if (r < 0 || r + a_len > rows () || c < 0 || c >= cols ()) |
458 | 399 { |
400 (*current_liboctave_error_handler) ("range error for insert"); | |
401 return *this; | |
402 } | |
403 | |
4316 | 404 if (a_len > 0) |
405 { | |
406 make_unique (); | |
407 | |
5275 | 408 for (octave_idx_type i = 0; i < a_len; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
409 xelem (r+i, c) = a.elem (i); |
4316 | 410 } |
458 | 411 |
412 return *this; | |
413 } | |
414 | |
415 ComplexMatrix& | |
5275 | 416 ComplexMatrix::insert (const DiagMatrix& a, octave_idx_type r, octave_idx_type c) |
458 | 417 { |
5275 | 418 octave_idx_type a_nr = a.rows (); |
419 octave_idx_type a_nc = a.cols (); | |
1699 | 420 |
421 if (r < 0 || r + a_nr > rows () || c < 0 || c + a_nc > cols ()) | |
458 | 422 { |
423 (*current_liboctave_error_handler) ("range error for insert"); | |
424 return *this; | |
425 } | |
426 | |
1699 | 427 fill (0.0, r, c, r + a_nr - 1, c + a_nc - 1); |
428 | |
5275 | 429 octave_idx_type a_len = a.length (); |
4316 | 430 |
431 if (a_len > 0) | |
432 { | |
433 make_unique (); | |
434 | |
5275 | 435 for (octave_idx_type i = 0; i < a_len; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
436 xelem (r+i, c+i) = a.elem (i, i); |
4316 | 437 } |
458 | 438 |
439 return *this; | |
440 } | |
441 | |
442 ComplexMatrix& | |
5275 | 443 ComplexMatrix::insert (const ComplexMatrix& a, octave_idx_type r, octave_idx_type c) |
458 | 444 { |
1561 | 445 Array2<Complex>::insert (a, r, c); |
458 | 446 return *this; |
447 } | |
448 | |
449 ComplexMatrix& | |
5275 | 450 ComplexMatrix::insert (const ComplexRowVector& a, octave_idx_type r, octave_idx_type c) |
458 | 451 { |
5275 | 452 octave_idx_type a_len = a.length (); |
1699 | 453 if (r < 0 || r >= rows () || c < 0 || c + a_len > cols ()) |
458 | 454 { |
455 (*current_liboctave_error_handler) ("range error for insert"); | |
456 return *this; | |
457 } | |
458 | |
5275 | 459 for (octave_idx_type i = 0; i < a_len; i++) |
458 | 460 elem (r, c+i) = a.elem (i); |
461 | |
462 return *this; | |
463 } | |
464 | |
465 ComplexMatrix& | |
5275 | 466 ComplexMatrix::insert (const ComplexColumnVector& a, octave_idx_type r, octave_idx_type c) |
458 | 467 { |
5275 | 468 octave_idx_type a_len = a.length (); |
4316 | 469 |
1699 | 470 if (r < 0 || r + a_len > rows () || c < 0 || c >= cols ()) |
458 | 471 { |
472 (*current_liboctave_error_handler) ("range error for insert"); | |
473 return *this; | |
474 } | |
475 | |
4316 | 476 if (a_len > 0) |
477 { | |
478 make_unique (); | |
479 | |
5275 | 480 for (octave_idx_type i = 0; i < a_len; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
481 xelem (r+i, c) = a.elem (i); |
4316 | 482 } |
458 | 483 |
484 return *this; | |
485 } | |
486 | |
487 ComplexMatrix& | |
5275 | 488 ComplexMatrix::insert (const ComplexDiagMatrix& a, octave_idx_type r, octave_idx_type c) |
458 | 489 { |
5275 | 490 octave_idx_type a_nr = a.rows (); |
491 octave_idx_type a_nc = a.cols (); | |
1699 | 492 |
493 if (r < 0 || r + a_nr > rows () || c < 0 || c + a_nc > cols ()) | |
458 | 494 { |
495 (*current_liboctave_error_handler) ("range error for insert"); | |
496 return *this; | |
497 } | |
498 | |
1699 | 499 fill (0.0, r, c, r + a_nr - 1, c + a_nc - 1); |
500 | |
5275 | 501 octave_idx_type a_len = a.length (); |
4316 | 502 |
503 if (a_len > 0) | |
504 { | |
505 make_unique (); | |
506 | |
5275 | 507 for (octave_idx_type i = 0; i < a_len; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
508 xelem (r+i, c+i) = a.elem (i, i); |
4316 | 509 } |
458 | 510 |
511 return *this; | |
512 } | |
513 | |
514 ComplexMatrix& | |
515 ComplexMatrix::fill (double val) | |
516 { | |
5275 | 517 octave_idx_type nr = rows (); |
518 octave_idx_type nc = cols (); | |
4316 | 519 |
458 | 520 if (nr > 0 && nc > 0) |
4316 | 521 { |
522 make_unique (); | |
523 | |
5275 | 524 for (octave_idx_type j = 0; j < nc; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
525 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
526 xelem (i, j) = val; |
4316 | 527 } |
458 | 528 |
529 return *this; | |
530 } | |
531 | |
532 ComplexMatrix& | |
533 ComplexMatrix::fill (const Complex& val) | |
534 { | |
5275 | 535 octave_idx_type nr = rows (); |
536 octave_idx_type nc = cols (); | |
4316 | 537 |
458 | 538 if (nr > 0 && nc > 0) |
4316 | 539 { |
540 make_unique (); | |
541 | |
5275 | 542 for (octave_idx_type j = 0; j < nc; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
543 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
544 xelem (i, j) = val; |
4316 | 545 } |
458 | 546 |
547 return *this; | |
548 } | |
549 | |
550 ComplexMatrix& | |
5275 | 551 ComplexMatrix::fill (double val, octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2) |
458 | 552 { |
5275 | 553 octave_idx_type nr = rows (); |
554 octave_idx_type nc = cols (); | |
4316 | 555 |
458 | 556 if (r1 < 0 || r2 < 0 || c1 < 0 || c2 < 0 |
557 || r1 >= nr || r2 >= nr || c1 >= nc || c2 >= nc) | |
558 { | |
559 (*current_liboctave_error_handler) ("range error for fill"); | |
560 return *this; | |
561 } | |
562 | |
5275 | 563 if (r1 > r2) { octave_idx_type tmp = r1; r1 = r2; r2 = tmp; } |
564 if (c1 > c2) { octave_idx_type tmp = c1; c1 = c2; c2 = tmp; } | |
458 | 565 |
4316 | 566 if (r2 >= r1 && c2 >= c1) |
567 { | |
568 make_unique (); | |
569 | |
5275 | 570 for (octave_idx_type j = c1; j <= c2; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
571 for (octave_idx_type i = r1; i <= r2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
572 xelem (i, j) = val; |
4316 | 573 } |
458 | 574 |
575 return *this; | |
576 } | |
577 | |
578 ComplexMatrix& | |
5275 | 579 ComplexMatrix::fill (const Complex& val, octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2) |
458 | 580 { |
5275 | 581 octave_idx_type nr = rows (); |
582 octave_idx_type nc = cols (); | |
4316 | 583 |
458 | 584 if (r1 < 0 || r2 < 0 || c1 < 0 || c2 < 0 |
585 || r1 >= nr || r2 >= nr || c1 >= nc || c2 >= nc) | |
586 { | |
587 (*current_liboctave_error_handler) ("range error for fill"); | |
588 return *this; | |
589 } | |
590 | |
5275 | 591 if (r1 > r2) { octave_idx_type tmp = r1; r1 = r2; r2 = tmp; } |
592 if (c1 > c2) { octave_idx_type tmp = c1; c1 = c2; c2 = tmp; } | |
458 | 593 |
4316 | 594 if (r2 >= r1 && c2 >=c1) |
595 { | |
596 make_unique (); | |
597 | |
5275 | 598 for (octave_idx_type j = c1; j <= c2; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
599 for (octave_idx_type i = r1; i <= r2; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
600 xelem (i, j) = val; |
4316 | 601 } |
458 | 602 |
603 return *this; | |
604 } | |
605 | |
606 ComplexMatrix | |
607 ComplexMatrix::append (const Matrix& a) const | |
608 { | |
5275 | 609 octave_idx_type nr = rows (); |
610 octave_idx_type nc = cols (); | |
458 | 611 if (nr != a.rows ()) |
612 { | |
613 (*current_liboctave_error_handler) ("row dimension mismatch for append"); | |
614 return *this; | |
615 } | |
616 | |
5275 | 617 octave_idx_type nc_insert = nc; |
458 | 618 ComplexMatrix retval (nr, nc + a.cols ()); |
619 retval.insert (*this, 0, 0); | |
620 retval.insert (a, 0, nc_insert); | |
621 return retval; | |
622 } | |
623 | |
624 ComplexMatrix | |
625 ComplexMatrix::append (const RowVector& a) const | |
626 { | |
5275 | 627 octave_idx_type nr = rows (); |
628 octave_idx_type nc = cols (); | |
458 | 629 if (nr != 1) |
630 { | |
631 (*current_liboctave_error_handler) ("row dimension mismatch for append"); | |
632 return *this; | |
633 } | |
634 | |
5275 | 635 octave_idx_type nc_insert = nc; |
458 | 636 ComplexMatrix retval (nr, nc + a.length ()); |
637 retval.insert (*this, 0, 0); | |
638 retval.insert (a, 0, nc_insert); | |
639 return retval; | |
640 } | |
641 | |
642 ComplexMatrix | |
643 ComplexMatrix::append (const ColumnVector& a) const | |
644 { | |
5275 | 645 octave_idx_type nr = rows (); |
646 octave_idx_type nc = cols (); | |
458 | 647 if (nr != a.length ()) |
648 { | |
649 (*current_liboctave_error_handler) ("row dimension mismatch for append"); | |
650 return *this; | |
651 } | |
652 | |
5275 | 653 octave_idx_type nc_insert = nc; |
458 | 654 ComplexMatrix retval (nr, nc + 1); |
655 retval.insert (*this, 0, 0); | |
656 retval.insert (a, 0, nc_insert); | |
657 return retval; | |
658 } | |
659 | |
660 ComplexMatrix | |
661 ComplexMatrix::append (const DiagMatrix& a) const | |
662 { | |
5275 | 663 octave_idx_type nr = rows (); |
664 octave_idx_type nc = cols (); | |
458 | 665 if (nr != a.rows ()) |
666 { | |
667 (*current_liboctave_error_handler) ("row dimension mismatch for append"); | |
668 return *this; | |
669 } | |
670 | |
5275 | 671 octave_idx_type nc_insert = nc; |
458 | 672 ComplexMatrix retval (nr, nc + a.cols ()); |
673 retval.insert (*this, 0, 0); | |
674 retval.insert (a, 0, nc_insert); | |
675 return retval; | |
676 } | |
677 | |
678 ComplexMatrix | |
679 ComplexMatrix::append (const ComplexMatrix& a) const | |
680 { | |
5275 | 681 octave_idx_type nr = rows (); |
682 octave_idx_type nc = cols (); | |
458 | 683 if (nr != a.rows ()) |
684 { | |
685 (*current_liboctave_error_handler) ("row dimension mismatch for append"); | |
686 return *this; | |
687 } | |
688 | |
5275 | 689 octave_idx_type nc_insert = nc; |
458 | 690 ComplexMatrix retval (nr, nc + a.cols ()); |
691 retval.insert (*this, 0, 0); | |
692 retval.insert (a, 0, nc_insert); | |
693 return retval; | |
694 } | |
695 | |
696 ComplexMatrix | |
697 ComplexMatrix::append (const ComplexRowVector& a) const | |
698 { | |
5275 | 699 octave_idx_type nr = rows (); |
700 octave_idx_type nc = cols (); | |
458 | 701 if (nr != 1) |
702 { | |
703 (*current_liboctave_error_handler) ("row dimension mismatch for append"); | |
704 return *this; | |
705 } | |
706 | |
5275 | 707 octave_idx_type nc_insert = nc; |
458 | 708 ComplexMatrix retval (nr, nc + a.length ()); |
709 retval.insert (*this, 0, 0); | |
710 retval.insert (a, 0, nc_insert); | |
711 return retval; | |
712 } | |
713 | |
714 ComplexMatrix | |
715 ComplexMatrix::append (const ComplexColumnVector& a) const | |
716 { | |
5275 | 717 octave_idx_type nr = rows (); |
718 octave_idx_type nc = cols (); | |
458 | 719 if (nr != a.length ()) |
720 { | |
721 (*current_liboctave_error_handler) ("row dimension mismatch for append"); | |
722 return *this; | |
723 } | |
724 | |
5275 | 725 octave_idx_type nc_insert = nc; |
458 | 726 ComplexMatrix retval (nr, nc + 1); |
727 retval.insert (*this, 0, 0); | |
728 retval.insert (a, 0, nc_insert); | |
729 return retval; | |
730 } | |
731 | |
732 ComplexMatrix | |
733 ComplexMatrix::append (const ComplexDiagMatrix& a) const | |
734 { | |
5275 | 735 octave_idx_type nr = rows (); |
736 octave_idx_type nc = cols (); | |
458 | 737 if (nr != a.rows ()) |
738 { | |
739 (*current_liboctave_error_handler) ("row dimension mismatch for append"); | |
740 return *this; | |
741 } | |
742 | |
5275 | 743 octave_idx_type nc_insert = nc; |
458 | 744 ComplexMatrix retval (nr, nc + a.cols ()); |
745 retval.insert (*this, 0, 0); | |
746 retval.insert (a, 0, nc_insert); | |
747 return retval; | |
748 } | |
749 | |
750 ComplexMatrix | |
751 ComplexMatrix::stack (const Matrix& a) const | |
752 { | |
5275 | 753 octave_idx_type nr = rows (); |
754 octave_idx_type nc = cols (); | |
458 | 755 if (nc != a.cols ()) |
756 { | |
757 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
758 ("column dimension mismatch for stack"); |
458 | 759 return *this; |
760 } | |
761 | |
5275 | 762 octave_idx_type nr_insert = nr; |
458 | 763 ComplexMatrix retval (nr + a.rows (), nc); |
764 retval.insert (*this, 0, 0); | |
765 retval.insert (a, nr_insert, 0); | |
766 return retval; | |
767 } | |
768 | |
769 ComplexMatrix | |
770 ComplexMatrix::stack (const RowVector& a) const | |
771 { | |
5275 | 772 octave_idx_type nr = rows (); |
773 octave_idx_type nc = cols (); | |
458 | 774 if (nc != a.length ()) |
775 { | |
776 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
777 ("column dimension mismatch for stack"); |
458 | 778 return *this; |
779 } | |
780 | |
5275 | 781 octave_idx_type nr_insert = nr; |
458 | 782 ComplexMatrix retval (nr + 1, nc); |
783 retval.insert (*this, 0, 0); | |
784 retval.insert (a, nr_insert, 0); | |
785 return retval; | |
786 } | |
787 | |
788 ComplexMatrix | |
789 ComplexMatrix::stack (const ColumnVector& a) const | |
790 { | |
5275 | 791 octave_idx_type nr = rows (); |
792 octave_idx_type nc = cols (); | |
458 | 793 if (nc != 1) |
794 { | |
795 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
796 ("column dimension mismatch for stack"); |
458 | 797 return *this; |
798 } | |
799 | |
5275 | 800 octave_idx_type nr_insert = nr; |
458 | 801 ComplexMatrix retval (nr + a.length (), nc); |
802 retval.insert (*this, 0, 0); | |
803 retval.insert (a, nr_insert, 0); | |
804 return retval; | |
805 } | |
806 | |
807 ComplexMatrix | |
808 ComplexMatrix::stack (const DiagMatrix& a) const | |
809 { | |
5275 | 810 octave_idx_type nr = rows (); |
811 octave_idx_type nc = cols (); | |
458 | 812 if (nc != a.cols ()) |
813 { | |
814 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
815 ("column dimension mismatch for stack"); |
458 | 816 return *this; |
817 } | |
818 | |
5275 | 819 octave_idx_type nr_insert = nr; |
458 | 820 ComplexMatrix retval (nr + a.rows (), nc); |
821 retval.insert (*this, 0, 0); | |
822 retval.insert (a, nr_insert, 0); | |
823 return retval; | |
824 } | |
825 | |
826 ComplexMatrix | |
827 ComplexMatrix::stack (const ComplexMatrix& a) const | |
828 { | |
5275 | 829 octave_idx_type nr = rows (); |
830 octave_idx_type nc = cols (); | |
458 | 831 if (nc != a.cols ()) |
832 { | |
833 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
834 ("column dimension mismatch for stack"); |
458 | 835 return *this; |
836 } | |
837 | |
5275 | 838 octave_idx_type nr_insert = nr; |
458 | 839 ComplexMatrix retval (nr + a.rows (), nc); |
840 retval.insert (*this, 0, 0); | |
841 retval.insert (a, nr_insert, 0); | |
842 return retval; | |
843 } | |
844 | |
845 ComplexMatrix | |
846 ComplexMatrix::stack (const ComplexRowVector& a) const | |
847 { | |
5275 | 848 octave_idx_type nr = rows (); |
849 octave_idx_type nc = cols (); | |
458 | 850 if (nc != a.length ()) |
851 { | |
852 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
853 ("column dimension mismatch for stack"); |
458 | 854 return *this; |
855 } | |
856 | |
5275 | 857 octave_idx_type nr_insert = nr; |
458 | 858 ComplexMatrix retval (nr + 1, nc); |
859 retval.insert (*this, 0, 0); | |
860 retval.insert (a, nr_insert, 0); | |
861 return retval; | |
862 } | |
863 | |
864 ComplexMatrix | |
865 ComplexMatrix::stack (const ComplexColumnVector& a) const | |
866 { | |
5275 | 867 octave_idx_type nr = rows (); |
868 octave_idx_type nc = cols (); | |
458 | 869 if (nc != 1) |
870 { | |
871 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
872 ("column dimension mismatch for stack"); |
458 | 873 return *this; |
874 } | |
875 | |
5275 | 876 octave_idx_type nr_insert = nr; |
458 | 877 ComplexMatrix retval (nr + a.length (), nc); |
878 retval.insert (*this, 0, 0); | |
879 retval.insert (a, nr_insert, 0); | |
880 return retval; | |
881 } | |
882 | |
883 ComplexMatrix | |
884 ComplexMatrix::stack (const ComplexDiagMatrix& a) const | |
885 { | |
5275 | 886 octave_idx_type nr = rows (); |
887 octave_idx_type nc = cols (); | |
458 | 888 if (nc != a.cols ()) |
889 { | |
890 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
891 ("column dimension mismatch for stack"); |
458 | 892 return *this; |
893 } | |
894 | |
5275 | 895 octave_idx_type nr_insert = nr; |
458 | 896 ComplexMatrix retval (nr + a.rows (), nc); |
897 retval.insert (*this, 0, 0); | |
898 retval.insert (a, nr_insert, 0); | |
899 return retval; | |
900 } | |
901 | |
902 ComplexMatrix | |
903 conj (const ComplexMatrix& a) | |
904 { | |
8650
a1ae2aae903e
abs,real,imag,conj: use code from mx-inlines rather than the generic map
Jaroslav Hajek <highegg@gmail.com>
parents:
8614
diff
changeset
|
905 return ComplexMatrix (mx_inline_conj_dup (a.data (), a.length ()), |
a1ae2aae903e
abs,real,imag,conj: use code from mx-inlines rather than the generic map
Jaroslav Hajek <highegg@gmail.com>
parents:
8614
diff
changeset
|
906 a.rows (), a.cols ()); |
458 | 907 } |
908 | |
909 // resize is the destructive equivalent for this one | |
910 | |
911 ComplexMatrix | |
5275 | 912 ComplexMatrix::extract (octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2) const |
458 | 913 { |
5275 | 914 if (r1 > r2) { octave_idx_type tmp = r1; r1 = r2; r2 = tmp; } |
915 if (c1 > c2) { octave_idx_type tmp = c1; c1 = c2; c2 = tmp; } | |
916 | |
917 octave_idx_type new_r = r2 - r1 + 1; | |
918 octave_idx_type new_c = c2 - c1 + 1; | |
458 | 919 |
920 ComplexMatrix result (new_r, new_c); | |
921 | |
5275 | 922 for (octave_idx_type j = 0; j < new_c; j++) |
923 for (octave_idx_type i = 0; i < new_r; i++) | |
4316 | 924 result.xelem (i, j) = elem (r1+i, c1+j); |
925 | |
926 return result; | |
927 } | |
928 | |
929 ComplexMatrix | |
5275 | 930 ComplexMatrix::extract_n (octave_idx_type r1, octave_idx_type c1, octave_idx_type nr, octave_idx_type nc) const |
4316 | 931 { |
932 ComplexMatrix result (nr, nc); | |
933 | |
5275 | 934 for (octave_idx_type j = 0; j < nc; j++) |
935 for (octave_idx_type i = 0; i < nr; i++) | |
4316 | 936 result.xelem (i, j) = elem (r1+i, c1+j); |
458 | 937 |
938 return result; | |
939 } | |
940 | |
941 // extract row or column i. | |
942 | |
943 ComplexRowVector | |
5275 | 944 ComplexMatrix::row (octave_idx_type i) const |
458 | 945 { |
8614
5114ea5a41b5
use shallow copying in Matrix/RowVector/ColumnVector conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8392
diff
changeset
|
946 return MArray<Complex> (index (idx_vector (i), idx_vector::colon)); |
458 | 947 } |
948 | |
949 ComplexColumnVector | |
5275 | 950 ComplexMatrix::column (octave_idx_type i) const |
458 | 951 { |
8614
5114ea5a41b5
use shallow copying in Matrix/RowVector/ColumnVector conversions
Jaroslav Hajek <highegg@gmail.com>
parents:
8392
diff
changeset
|
952 return MArray<Complex> (index (idx_vector::colon, idx_vector (i))); |
458 | 953 } |
954 | |
955 ComplexMatrix | |
956 ComplexMatrix::inverse (void) const | |
957 { | |
5275 | 958 octave_idx_type info; |
7788 | 959 double rcon; |
6207 | 960 MatrixType mattype (*this); |
7788 | 961 return inverse (mattype, info, rcon, 0, 0); |
6207 | 962 } |
963 | |
964 ComplexMatrix | |
6479 | 965 ComplexMatrix::inverse (octave_idx_type& info) const |
966 { | |
7788 | 967 double rcon; |
6479 | 968 MatrixType mattype (*this); |
7788 | 969 return inverse (mattype, info, rcon, 0, 0); |
6479 | 970 } |
971 | |
972 ComplexMatrix | |
7788 | 973 ComplexMatrix::inverse (octave_idx_type& info, double& rcon, int force, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
974 int calc_cond) const |
6479 | 975 { |
976 MatrixType mattype (*this); | |
7788 | 977 return inverse (mattype, info, rcon, force, calc_cond); |
6479 | 978 } |
979 | |
980 ComplexMatrix | |
6207 | 981 ComplexMatrix::inverse (MatrixType &mattype) const |
982 { | |
983 octave_idx_type info; | |
7788 | 984 double rcon; |
985 return inverse (mattype, info, rcon, 0, 0); | |
6207 | 986 } |
987 | |
988 ComplexMatrix | |
989 ComplexMatrix::inverse (MatrixType &mattype, octave_idx_type& info) const | |
990 { | |
7788 | 991 double rcon; |
992 return inverse (mattype, info, rcon, 0, 0); | |
458 | 993 } |
994 | |
995 ComplexMatrix | |
6207 | 996 ComplexMatrix::tinverse (MatrixType &mattype, octave_idx_type& info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
997 double& rcon, int force, int calc_cond) const |
458 | 998 { |
6207 | 999 ComplexMatrix retval; |
1000 | |
1001 octave_idx_type nr = rows (); | |
1002 octave_idx_type nc = cols (); | |
1003 | |
1004 if (nr != nc || nr == 0 || nc == 0) | |
1005 (*current_liboctave_error_handler) ("inverse requires square matrix"); | |
1006 else | |
1007 { | |
1008 int typ = mattype.type (); | |
1009 char uplo = (typ == MatrixType::Lower ? 'L' : 'U'); | |
1010 char udiag = 'N'; | |
1011 retval = *this; | |
1012 Complex *tmp_data = retval.fortran_vec (); | |
1013 | |
1014 F77_XFCN (ztrtri, ZTRTRI, (F77_CONST_CHAR_ARG2 (&uplo, 1), | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1015 F77_CONST_CHAR_ARG2 (&udiag, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1016 nr, tmp_data, nr, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1017 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1018 F77_CHAR_ARG_LEN (1))); |
6207 | 1019 |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
1020 // Throw-away extra info LAPACK gives so as to not change output. |
7788 | 1021 rcon = 0.0; |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
1022 if (info != 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1023 info = -1; |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
1024 else if (calc_cond) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1025 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1026 octave_idx_type ztrcon_info = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1027 char job = '1'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1028 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1029 OCTAVE_LOCAL_BUFFER (Complex, cwork, 2*nr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1030 OCTAVE_LOCAL_BUFFER (double, rwork, nr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1031 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1032 F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&job, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1033 F77_CONST_CHAR_ARG2 (&uplo, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1034 F77_CONST_CHAR_ARG2 (&udiag, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1035 nr, tmp_data, nr, rcon, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1036 cwork, rwork, ztrcon_info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1037 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1038 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1039 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1040 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1041 if (ztrcon_info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1042 info = -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1043 } |
6207 | 1044 |
1045 if (info == -1 && ! force) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1046 retval = *this; // Restore matrix contents. |
6207 | 1047 } |
1048 | |
1049 return retval; | |
458 | 1050 } |
1051 | |
1052 ComplexMatrix | |
6207 | 1053 ComplexMatrix::finverse (MatrixType &mattype, octave_idx_type& info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1054 double& rcon, int force, int calc_cond) const |
458 | 1055 { |
1948 | 1056 ComplexMatrix retval; |
1057 | |
5275 | 1058 octave_idx_type nr = rows (); |
1059 octave_idx_type nc = cols (); | |
1948 | 1060 |
458 | 1061 if (nr != nc) |
1948 | 1062 (*current_liboctave_error_handler) ("inverse requires square matrix"); |
458 | 1063 else |
1064 { | |
5275 | 1065 Array<octave_idx_type> ipvt (nr); |
1066 octave_idx_type *pipvt = ipvt.fortran_vec (); | |
1948 | 1067 |
1068 retval = *this; | |
1069 Complex *tmp_data = retval.fortran_vec (); | |
1070 | |
4329 | 1071 Array<Complex> z(1); |
5275 | 1072 octave_idx_type lwork = -1; |
4330 | 1073 |
1074 // Query the optimum work array size. | |
4329 | 1075 |
1076 F77_XFCN (zgetri, ZGETRI, (nc, tmp_data, nr, pipvt, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1077 z.fortran_vec (), lwork, info)); |
4329 | 1078 |
5315 | 1079 lwork = static_cast<octave_idx_type> (std::real(z(0))); |
4329 | 1080 lwork = (lwork < 2 *nc ? 2*nc : lwork); |
1081 z.resize (lwork); | |
1082 Complex *pz = z.fortran_vec (); | |
1083 | |
1084 info = 0; | |
1085 | |
4330 | 1086 // Calculate the norm of the matrix, for later use. |
4329 | 1087 double anorm; |
1088 if (calc_cond) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1089 anorm = retval.abs().sum().row(static_cast<octave_idx_type>(0)).max(); |
4329 | 1090 |
1091 F77_XFCN (zgetrf, ZGETRF, (nc, nc, tmp_data, nr, pipvt, info)); | |
1948 | 1092 |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
1093 // Throw-away extra info LAPACK gives so as to not change output. |
7788 | 1094 rcon = 0.0; |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
1095 if (info != 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1096 info = -1; |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
1097 else if (calc_cond) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1098 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1099 // Now calculate the condition number for non-singular matrix. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1100 octave_idx_type zgecon_info = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1101 char job = '1'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1102 Array<double> rz (2 * nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1103 double *prz = rz.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1104 F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1105 nc, tmp_data, nr, anorm, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1106 rcon, pz, prz, zgecon_info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1107 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1108 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1109 if (zgecon_info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1110 info = -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1111 } |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
1112 |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
1113 if (info == -1 && ! force) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1114 retval = *this; // Restore contents. |
1948 | 1115 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1116 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1117 octave_idx_type zgetri_info = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1118 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1119 F77_XFCN (zgetri, ZGETRI, (nc, tmp_data, nr, pipvt, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1120 pz, lwork, zgetri_info)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1121 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1122 if (zgetri_info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1123 info = -1; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1124 } |
6207 | 1125 |
1126 if (info != 0) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1127 mattype.mark_as_rectangular(); |
458 | 1128 } |
4329 | 1129 |
1948 | 1130 return retval; |
458 | 1131 } |
1132 | |
1133 ComplexMatrix | |
6207 | 1134 ComplexMatrix::inverse (MatrixType &mattype, octave_idx_type& info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1135 double& rcon, int force, int calc_cond) const |
6207 | 1136 { |
1137 int typ = mattype.type (false); | |
1138 ComplexMatrix ret; | |
1139 | |
1140 if (typ == MatrixType::Unknown) | |
1141 typ = mattype.type (*this); | |
1142 | |
1143 if (typ == MatrixType::Upper || typ == MatrixType::Lower) | |
7788 | 1144 ret = tinverse (mattype, info, rcon, force, calc_cond); |
6840 | 1145 else |
6207 | 1146 { |
1147 if (mattype.is_hermitian ()) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1148 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1149 ComplexCHOL chol (*this, info, calc_cond); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1150 if (info == 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1151 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1152 if (calc_cond) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1153 rcon = chol.rcond(); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1154 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1155 rcon = 1.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1156 ret = chol.inverse (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1157 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1158 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1159 mattype.mark_as_unsymmetric (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1160 } |
6207 | 1161 |
1162 if (!mattype.is_hermitian ()) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1163 ret = finverse(mattype, info, rcon, force, calc_cond); |
7788 | 1164 |
1165 if ((mattype.is_hermitian () || calc_cond) && rcon == 0.) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1166 ret = ComplexMatrix (rows (), columns (), Complex (octave_Inf, 0.)); |
6207 | 1167 } |
1168 | |
1169 return ret; | |
1170 } | |
1171 | |
1172 ComplexMatrix | |
4384 | 1173 ComplexMatrix::pseudo_inverse (double tol) const |
740 | 1174 { |
1549 | 1175 ComplexMatrix retval; |
1176 | |
3480 | 1177 ComplexSVD result (*this, SVD::economy); |
740 | 1178 |
1179 DiagMatrix S = result.singular_values (); | |
1180 ComplexMatrix U = result.left_singular_matrix (); | |
1181 ComplexMatrix V = result.right_singular_matrix (); | |
1182 | |
1183 ColumnVector sigma = S.diag (); | |
1184 | |
5275 | 1185 octave_idx_type r = sigma.length () - 1; |
1186 octave_idx_type nr = rows (); | |
1187 octave_idx_type nc = cols (); | |
740 | 1188 |
1189 if (tol <= 0.0) | |
1190 { | |
1191 if (nr > nc) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1192 tol = nr * sigma.elem (0) * DBL_EPSILON; |
740 | 1193 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1194 tol = nc * sigma.elem (0) * DBL_EPSILON; |
740 | 1195 } |
1196 | |
1197 while (r >= 0 && sigma.elem (r) < tol) | |
1198 r--; | |
1199 | |
1200 if (r < 0) | |
1549 | 1201 retval = ComplexMatrix (nc, nr, 0.0); |
740 | 1202 else |
1203 { | |
1204 ComplexMatrix Ur = U.extract (0, 0, nr-1, r); | |
1205 DiagMatrix D = DiagMatrix (sigma.extract (0, r)) . inverse (); | |
1206 ComplexMatrix Vr = V.extract (0, 0, nc-1, r); | |
1549 | 1207 retval = Vr * D * Ur.hermitian (); |
740 | 1208 } |
1549 | 1209 |
1210 return retval; | |
740 | 1211 } |
1212 | |
9523
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1213 #if defined (HAVE_FFTW) |
3827 | 1214 |
1215 ComplexMatrix | |
1216 ComplexMatrix::fourier (void) const | |
1217 { | |
1218 size_t nr = rows (); | |
1219 size_t nc = cols (); | |
1220 | |
1221 ComplexMatrix retval (nr, nc); | |
1222 | |
1223 size_t npts, nsamples; | |
1224 | |
1225 if (nr == 1 || nc == 1) | |
1226 { | |
1227 npts = nr > nc ? nr : nc; | |
1228 nsamples = 1; | |
1229 } | |
1230 else | |
1231 { | |
1232 npts = nr; | |
1233 nsamples = nc; | |
1234 } | |
1235 | |
1236 const Complex *in (data ()); | |
1237 Complex *out (retval.fortran_vec ()); | |
1238 | |
4773 | 1239 octave_fftw::fft (in, out, npts, nsamples); |
3827 | 1240 |
1241 return retval; | |
1242 } | |
1243 | |
1244 ComplexMatrix | |
1245 ComplexMatrix::ifourier (void) const | |
1246 { | |
1247 size_t nr = rows (); | |
1248 size_t nc = cols (); | |
1249 | |
1250 ComplexMatrix retval (nr, nc); | |
1251 | |
1252 size_t npts, nsamples; | |
1253 | |
1254 if (nr == 1 || nc == 1) | |
1255 { | |
1256 npts = nr > nc ? nr : nc; | |
1257 nsamples = 1; | |
1258 } | |
1259 else | |
1260 { | |
1261 npts = nr; | |
1262 nsamples = nc; | |
1263 } | |
1264 | |
1265 const Complex *in (data ()); | |
1266 Complex *out (retval.fortran_vec ()); | |
1267 | |
4773 | 1268 octave_fftw::ifft (in, out, npts, nsamples); |
3827 | 1269 |
1270 return retval; | |
1271 } | |
1272 | |
1273 ComplexMatrix | |
1274 ComplexMatrix::fourier2d (void) const | |
1275 { | |
4773 | 1276 dim_vector dv(rows (), cols ()); |
1277 | |
1278 ComplexMatrix retval (rows (), cols ()); | |
1279 const Complex *in (data ()); | |
1280 Complex *out (retval.fortran_vec ()); | |
1281 | |
1282 octave_fftw::fftNd (in, out, 2, dv); | |
3827 | 1283 |
1284 return retval; | |
1285 } | |
1286 | |
1287 ComplexMatrix | |
1288 ComplexMatrix::ifourier2d (void) const | |
1289 { | |
4773 | 1290 dim_vector dv(rows (), cols ()); |
1291 | |
1292 ComplexMatrix retval (rows (), cols ()); | |
1293 const Complex *in (data ()); | |
1294 Complex *out (retval.fortran_vec ()); | |
1295 | |
1296 octave_fftw::ifftNd (in, out, 2, dv); | |
3827 | 1297 |
1298 return retval; | |
1299 } | |
1300 | |
1301 #else | |
1302 | |
9523
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1303 extern "C" |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1304 { |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1305 // Note that the original complex fft routines were not written for |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1306 // double complex arguments. They have been modified by adding an |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1307 // implicit double precision (a-h,o-z) statement at the beginning of |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1308 // each subroutine. |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1309 |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1310 F77_RET_T |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1311 F77_FUNC (zffti, ZFFTI) (const octave_idx_type&, Complex*); |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1312 |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1313 F77_RET_T |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1314 F77_FUNC (zfftf, ZFFTF) (const octave_idx_type&, Complex*, Complex*); |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1315 |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1316 F77_RET_T |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1317 F77_FUNC (zfftb, ZFFTB) (const octave_idx_type&, Complex*, Complex*); |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1318 } |
0ce82753dd72
more configure changes for libraries
John W. Eaton <jwe@octave.org>
parents:
9469
diff
changeset
|
1319 |
740 | 1320 ComplexMatrix |
458 | 1321 ComplexMatrix::fourier (void) const |
1322 { | |
1948 | 1323 ComplexMatrix retval; |
1324 | |
5275 | 1325 octave_idx_type nr = rows (); |
1326 octave_idx_type nc = cols (); | |
1327 | |
1328 octave_idx_type npts, nsamples; | |
1948 | 1329 |
458 | 1330 if (nr == 1 || nc == 1) |
1331 { | |
1332 npts = nr > nc ? nr : nc; | |
1333 nsamples = 1; | |
1334 } | |
1335 else | |
1336 { | |
1337 npts = nr; | |
1338 nsamples = nc; | |
1339 } | |
1340 | |
5275 | 1341 octave_idx_type nn = 4*npts+15; |
1948 | 1342 |
1343 Array<Complex> wsave (nn); | |
1344 Complex *pwsave = wsave.fortran_vec (); | |
1345 | |
1346 retval = *this; | |
1347 Complex *tmp_data = retval.fortran_vec (); | |
1348 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7788
diff
changeset
|
1349 F77_FUNC (zffti, ZFFTI) (npts, pwsave); |
458 | 1350 |
5275 | 1351 for (octave_idx_type j = 0; j < nsamples; j++) |
4153 | 1352 { |
10142
829e69ec3110
make OCTAVE_QUIT a function
Jaroslav Hajek <highegg@gmail.com>
parents:
10124
diff
changeset
|
1353 octave_quit (); |
4153 | 1354 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7788
diff
changeset
|
1355 F77_FUNC (zfftf, ZFFTF) (npts, &tmp_data[npts*j], pwsave); |
4153 | 1356 } |
1948 | 1357 |
1358 return retval; | |
458 | 1359 } |
1360 | |
1361 ComplexMatrix | |
1362 ComplexMatrix::ifourier (void) const | |
1363 { | |
1948 | 1364 ComplexMatrix retval; |
1365 | |
5275 | 1366 octave_idx_type nr = rows (); |
1367 octave_idx_type nc = cols (); | |
1368 | |
1369 octave_idx_type npts, nsamples; | |
1948 | 1370 |
458 | 1371 if (nr == 1 || nc == 1) |
1372 { | |
1373 npts = nr > nc ? nr : nc; | |
1374 nsamples = 1; | |
1375 } | |
1376 else | |
1377 { | |
1378 npts = nr; | |
1379 nsamples = nc; | |
1380 } | |
1381 | |
5275 | 1382 octave_idx_type nn = 4*npts+15; |
1948 | 1383 |
1384 Array<Complex> wsave (nn); | |
1385 Complex *pwsave = wsave.fortran_vec (); | |
1386 | |
1387 retval = *this; | |
1388 Complex *tmp_data = retval.fortran_vec (); | |
1389 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7788
diff
changeset
|
1390 F77_FUNC (zffti, ZFFTI) (npts, pwsave); |
458 | 1391 |
5275 | 1392 for (octave_idx_type j = 0; j < nsamples; j++) |
4153 | 1393 { |
10142
829e69ec3110
make OCTAVE_QUIT a function
Jaroslav Hajek <highegg@gmail.com>
parents:
10124
diff
changeset
|
1394 octave_quit (); |
4153 | 1395 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7788
diff
changeset
|
1396 F77_FUNC (zfftb, ZFFTB) (npts, &tmp_data[npts*j], pwsave); |
4153 | 1397 } |
458 | 1398 |
5275 | 1399 for (octave_idx_type j = 0; j < npts*nsamples; j++) |
3572 | 1400 tmp_data[j] = tmp_data[j] / static_cast<double> (npts); |
458 | 1401 |
1948 | 1402 return retval; |
458 | 1403 } |
1404 | |
677 | 1405 ComplexMatrix |
1406 ComplexMatrix::fourier2d (void) const | |
1407 { | |
1948 | 1408 ComplexMatrix retval; |
1409 | |
5275 | 1410 octave_idx_type nr = rows (); |
1411 octave_idx_type nc = cols (); | |
1412 | |
1413 octave_idx_type npts, nsamples; | |
1948 | 1414 |
677 | 1415 if (nr == 1 || nc == 1) |
1416 { | |
1417 npts = nr > nc ? nr : nc; | |
1418 nsamples = 1; | |
1419 } | |
1420 else | |
1421 { | |
1422 npts = nr; | |
1423 nsamples = nc; | |
1424 } | |
1425 | |
5275 | 1426 octave_idx_type nn = 4*npts+15; |
1948 | 1427 |
1428 Array<Complex> wsave (nn); | |
1429 Complex *pwsave = wsave.fortran_vec (); | |
1430 | |
1431 retval = *this; | |
1432 Complex *tmp_data = retval.fortran_vec (); | |
1433 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7788
diff
changeset
|
1434 F77_FUNC (zffti, ZFFTI) (npts, pwsave); |
677 | 1435 |
5275 | 1436 for (octave_idx_type j = 0; j < nsamples; j++) |
4153 | 1437 { |
10142
829e69ec3110
make OCTAVE_QUIT a function
Jaroslav Hajek <highegg@gmail.com>
parents:
10124
diff
changeset
|
1438 octave_quit (); |
4153 | 1439 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7788
diff
changeset
|
1440 F77_FUNC (zfftf, ZFFTF) (npts, &tmp_data[npts*j], pwsave); |
4153 | 1441 } |
677 | 1442 |
1443 npts = nc; | |
1444 nsamples = nr; | |
1445 nn = 4*npts+15; | |
1948 | 1446 |
1447 wsave.resize (nn); | |
1448 pwsave = wsave.fortran_vec (); | |
1449 | |
4773 | 1450 Array<Complex> tmp (npts); |
1451 Complex *prow = tmp.fortran_vec (); | |
1948 | 1452 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7788
diff
changeset
|
1453 F77_FUNC (zffti, ZFFTI) (npts, pwsave); |
677 | 1454 |
5275 | 1455 for (octave_idx_type j = 0; j < nsamples; j++) |
677 | 1456 { |
10142
829e69ec3110
make OCTAVE_QUIT a function
Jaroslav Hajek <highegg@gmail.com>
parents:
10124
diff
changeset
|
1457 octave_quit (); |
4153 | 1458 |
5275 | 1459 for (octave_idx_type i = 0; i < npts; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1460 prow[i] = tmp_data[i*nr + j]; |
1948 | 1461 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7788
diff
changeset
|
1462 F77_FUNC (zfftf, ZFFTF) (npts, prow, pwsave); |
677 | 1463 |
5275 | 1464 for (octave_idx_type i = 0; i < npts; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1465 tmp_data[i*nr + j] = prow[i]; |
677 | 1466 } |
1467 | |
1948 | 1468 return retval; |
677 | 1469 } |
1470 | |
1471 ComplexMatrix | |
1472 ComplexMatrix::ifourier2d (void) const | |
1473 { | |
1948 | 1474 ComplexMatrix retval; |
1475 | |
5275 | 1476 octave_idx_type nr = rows (); |
1477 octave_idx_type nc = cols (); | |
1478 | |
1479 octave_idx_type npts, nsamples; | |
1948 | 1480 |
677 | 1481 if (nr == 1 || nc == 1) |
1482 { | |
1483 npts = nr > nc ? nr : nc; | |
1484 nsamples = 1; | |
1485 } | |
1486 else | |
1487 { | |
1488 npts = nr; | |
1489 nsamples = nc; | |
1490 } | |
1491 | |
5275 | 1492 octave_idx_type nn = 4*npts+15; |
1948 | 1493 |
1494 Array<Complex> wsave (nn); | |
1495 Complex *pwsave = wsave.fortran_vec (); | |
1496 | |
1497 retval = *this; | |
1498 Complex *tmp_data = retval.fortran_vec (); | |
1499 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7788
diff
changeset
|
1500 F77_FUNC (zffti, ZFFTI) (npts, pwsave); |
677 | 1501 |
5275 | 1502 for (octave_idx_type j = 0; j < nsamples; j++) |
4153 | 1503 { |
10142
829e69ec3110
make OCTAVE_QUIT a function
Jaroslav Hajek <highegg@gmail.com>
parents:
10124
diff
changeset
|
1504 octave_quit (); |
4153 | 1505 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7788
diff
changeset
|
1506 F77_FUNC (zfftb, ZFFTB) (npts, &tmp_data[npts*j], pwsave); |
4153 | 1507 } |
677 | 1508 |
5275 | 1509 for (octave_idx_type j = 0; j < npts*nsamples; j++) |
3572 | 1510 tmp_data[j] = tmp_data[j] / static_cast<double> (npts); |
677 | 1511 |
1512 npts = nc; | |
1513 nsamples = nr; | |
1514 nn = 4*npts+15; | |
1948 | 1515 |
1516 wsave.resize (nn); | |
1517 pwsave = wsave.fortran_vec (); | |
1518 | |
4773 | 1519 Array<Complex> tmp (npts); |
1520 Complex *prow = tmp.fortran_vec (); | |
1948 | 1521 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7788
diff
changeset
|
1522 F77_FUNC (zffti, ZFFTI) (npts, pwsave); |
677 | 1523 |
5275 | 1524 for (octave_idx_type j = 0; j < nsamples; j++) |
677 | 1525 { |
10142
829e69ec3110
make OCTAVE_QUIT a function
Jaroslav Hajek <highegg@gmail.com>
parents:
10124
diff
changeset
|
1526 octave_quit (); |
4153 | 1527 |
5275 | 1528 for (octave_idx_type i = 0; i < npts; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1529 prow[i] = tmp_data[i*nr + j]; |
1948 | 1530 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7788
diff
changeset
|
1531 F77_FUNC (zfftb, ZFFTB) (npts, prow, pwsave); |
677 | 1532 |
5275 | 1533 for (octave_idx_type i = 0; i < npts; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1534 tmp_data[i*nr + j] = prow[i] / static_cast<double> (npts); |
677 | 1535 } |
1536 | |
1948 | 1537 return retval; |
677 | 1538 } |
1539 | |
3827 | 1540 #endif |
1541 | |
458 | 1542 ComplexDET |
1543 ComplexMatrix::determinant (void) const | |
1544 { | |
5275 | 1545 octave_idx_type info; |
7788 | 1546 double rcon; |
1547 return determinant (info, rcon, 0); | |
458 | 1548 } |
1549 | |
1550 ComplexDET | |
5275 | 1551 ComplexMatrix::determinant (octave_idx_type& info) const |
458 | 1552 { |
7788 | 1553 double rcon; |
1554 return determinant (info, rcon, 0); | |
458 | 1555 } |
1556 | |
1557 ComplexDET | |
7788 | 1558 ComplexMatrix::determinant (octave_idx_type& info, double& rcon, int calc_cond) const |
458 | 1559 { |
8336
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1560 MatrixType mattype (*this); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1561 return determinant (mattype, info, rcon, calc_cond); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1562 } |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1563 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1564 ComplexDET |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1565 ComplexMatrix::determinant (MatrixType& mattype, |
8806 | 1566 octave_idx_type& info, double& rcon, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1567 int calc_cond) const |
8336
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1568 { |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1569 ComplexDET retval (1.0); |
458 | 1570 |
5275 | 1571 octave_idx_type nr = rows (); |
1572 octave_idx_type nc = cols (); | |
458 | 1573 |
8336
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1574 if (nr != nc) |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1575 (*current_liboctave_error_handler) ("matrix must be square"); |
458 | 1576 else |
1577 { | |
8806 | 1578 volatile int typ = mattype.type (); |
8336
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1579 |
10213
f7ba6cfe7fb7
fix det() after singular matrix is flagged
Jaroslav Hajek <highegg@gmail.com>
parents:
10182
diff
changeset
|
1580 // Even though the matrix is marked as singular (Rectangular), we may |
f7ba6cfe7fb7
fix det() after singular matrix is flagged
Jaroslav Hajek <highegg@gmail.com>
parents:
10182
diff
changeset
|
1581 // still get a useful number from the LU factorization, because it always |
f7ba6cfe7fb7
fix det() after singular matrix is flagged
Jaroslav Hajek <highegg@gmail.com>
parents:
10182
diff
changeset
|
1582 // completes. |
f7ba6cfe7fb7
fix det() after singular matrix is flagged
Jaroslav Hajek <highegg@gmail.com>
parents:
10182
diff
changeset
|
1583 |
8337
e02242c54c49
reuse matrix type detected in det
Jaroslav Hajek <highegg@gmail.com>
parents:
8336
diff
changeset
|
1584 if (typ == MatrixType::Unknown) |
e02242c54c49
reuse matrix type detected in det
Jaroslav Hajek <highegg@gmail.com>
parents:
8336
diff
changeset
|
1585 typ = mattype.type (*this); |
10213
f7ba6cfe7fb7
fix det() after singular matrix is flagged
Jaroslav Hajek <highegg@gmail.com>
parents:
10182
diff
changeset
|
1586 else if (typ == MatrixType::Rectangular) |
f7ba6cfe7fb7
fix det() after singular matrix is flagged
Jaroslav Hajek <highegg@gmail.com>
parents:
10182
diff
changeset
|
1587 typ = MatrixType::Full; |
8337
e02242c54c49
reuse matrix type detected in det
Jaroslav Hajek <highegg@gmail.com>
parents:
8336
diff
changeset
|
1588 |
8336
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1589 if (typ == MatrixType::Lower || typ == MatrixType::Upper) |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1590 { |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1591 for (octave_idx_type i = 0; i < nc; i++) |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1592 retval *= elem (i,i); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1593 } |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1594 else if (typ == MatrixType::Hermitian) |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1595 { |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1596 ComplexMatrix atmp = *this; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1597 Complex *tmp_data = atmp.fortran_vec (); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1598 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1599 info = 0; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1600 double anorm = 0; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1601 if (calc_cond) anorm = xnorm (*this, 1); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1602 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1603 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1604 char job = 'L'; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1605 F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1606 tmp_data, nr, info |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1607 F77_CHAR_ARG_LEN (1))); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1608 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1609 if (info != 0) |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1610 { |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1611 rcon = 0.0; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1612 mattype.mark_as_unsymmetric (); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1613 typ = MatrixType::Full; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1614 } |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1615 else |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1616 { |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1617 Array<Complex> z (2 * nc); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1618 Complex *pz = z.fortran_vec (); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1619 Array<double> rz (nc); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1620 double *prz = rz.fortran_vec (); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1621 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1622 F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1623 nr, tmp_data, nr, anorm, |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1624 rcon, pz, prz, info |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1625 F77_CHAR_ARG_LEN (1))); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1626 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1627 if (info != 0) |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1628 rcon = 0.0; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1629 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1630 for (octave_idx_type i = 0; i < nc; i++) |
8337
e02242c54c49
reuse matrix type detected in det
Jaroslav Hajek <highegg@gmail.com>
parents:
8336
diff
changeset
|
1631 retval *= atmp (i,i); |
8336
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1632 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1633 retval = retval.square (); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1634 } |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1635 } |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1636 else if (typ != MatrixType::Full) |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1637 (*current_liboctave_error_handler) ("det: invalid dense matrix type"); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1638 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1639 if (typ == MatrixType::Full) |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1640 { |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1641 Array<octave_idx_type> ipvt (nr); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1642 octave_idx_type *pipvt = ipvt.fortran_vec (); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1643 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1644 ComplexMatrix atmp = *this; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1645 Complex *tmp_data = atmp.fortran_vec (); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1646 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1647 info = 0; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1648 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1649 // Calculate the norm of the matrix, for later use. |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1650 double anorm = 0; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1651 if (calc_cond) anorm = xnorm (*this, 1); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1652 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1653 F77_XFCN (zgetrf, ZGETRF, (nr, nr, tmp_data, nr, pipvt, info)); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1654 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1655 // Throw-away extra info LAPACK gives so as to not change output. |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1656 rcon = 0.0; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1657 if (info != 0) |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1658 { |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1659 info = -1; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1660 retval = ComplexDET (); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1661 } |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1662 else |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1663 { |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1664 if (calc_cond) |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1665 { |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1666 // Now calc the condition number for non-singular matrix. |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1667 char job = '1'; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1668 Array<Complex> z (2 * nc); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1669 Complex *pz = z.fortran_vec (); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1670 Array<double> rz (2 * nc); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1671 double *prz = rz.fortran_vec (); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1672 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1673 F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1674 nc, tmp_data, nr, anorm, |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1675 rcon, pz, prz, info |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1676 F77_CHAR_ARG_LEN (1))); |
8335 | 1677 } |
8336
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1678 |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1679 if (info != 0) |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1680 { |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1681 info = -1; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1682 retval = ComplexDET (); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1683 } |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1684 else |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1685 { |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1686 for (octave_idx_type i = 0; i < nc; i++) |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1687 { |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1688 Complex c = atmp(i,i); |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1689 retval *= (ipvt(i) != (i+1)) ? -c : c; |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1690 } |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1691 } |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1692 } |
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1693 } |
458 | 1694 } |
8336
9813c07ca946
make det take advantage of matrix type
Jaroslav Hajek <highegg@gmail.com>
parents:
8335
diff
changeset
|
1695 |
458 | 1696 return retval; |
1697 } | |
1698 | |
7788 | 1699 double |
1700 ComplexMatrix::rcond (void) const | |
1701 { | |
1702 MatrixType mattype (*this); | |
1703 return rcond (mattype); | |
1704 } | |
1705 | |
1706 double | |
1707 ComplexMatrix::rcond (MatrixType &mattype) const | |
1708 { | |
1709 double rcon; | |
1710 octave_idx_type nr = rows (); | |
1711 octave_idx_type nc = cols (); | |
1712 | |
1713 if (nr != nc) | |
1714 (*current_liboctave_error_handler) ("matrix must be square"); | |
1715 else if (nr == 0 || nc == 0) | |
1716 rcon = octave_Inf; | |
1717 else | |
1718 { | |
1719 int typ = mattype.type (); | |
1720 | |
1721 if (typ == MatrixType::Unknown) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1722 typ = mattype.type (*this); |
7788 | 1723 |
1724 // Only calculate the condition number for LU/Cholesky | |
1725 if (typ == MatrixType::Upper) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1726 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1727 const Complex *tmp_data = fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1728 octave_idx_type info = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1729 char norm = '1'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1730 char uplo = 'U'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1731 char dia = 'N'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1732 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1733 Array<Complex> z (2 * nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1734 Complex *pz = z.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1735 Array<double> rz (nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1736 double *prz = rz.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1737 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1738 F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1739 F77_CONST_CHAR_ARG2 (&uplo, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1740 F77_CONST_CHAR_ARG2 (&dia, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1741 nr, tmp_data, nr, rcon, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1742 pz, prz, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1743 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1744 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1745 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1746 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1747 if (info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1748 rcon = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1749 } |
7788 | 1750 else if (typ == MatrixType::Permuted_Upper) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1751 (*current_liboctave_error_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1752 ("permuted triangular matrix not implemented"); |
7788 | 1753 else if (typ == MatrixType::Lower) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1754 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1755 const Complex *tmp_data = fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1756 octave_idx_type info = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1757 char norm = '1'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1758 char uplo = 'L'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1759 char dia = 'N'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1760 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1761 Array<Complex> z (2 * nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1762 Complex *pz = z.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1763 Array<double> rz (nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1764 double *prz = rz.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1765 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1766 F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1767 F77_CONST_CHAR_ARG2 (&uplo, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1768 F77_CONST_CHAR_ARG2 (&dia, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1769 nr, tmp_data, nr, rcon, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1770 pz, prz, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1771 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1772 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1773 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1774 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1775 if (info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1776 rcon = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1777 } |
7788 | 1778 else if (typ == MatrixType::Permuted_Lower) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1779 (*current_liboctave_error_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1780 ("permuted triangular matrix not implemented"); |
7788 | 1781 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1782 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1783 double anorm = -1.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1784 ComplexMatrix atmp = *this; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1785 Complex *tmp_data = atmp.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1786 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1787 if (typ == MatrixType::Hermitian) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1788 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1789 octave_idx_type info = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1790 char job = 'L'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1791 anorm = atmp.abs().sum(). |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1792 row(static_cast<octave_idx_type>(0)).max(); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1793 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1794 F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1795 tmp_data, nr, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1796 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1797 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1798 if (info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1799 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1800 rcon = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1801 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1802 mattype.mark_as_unsymmetric (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1803 typ = MatrixType::Full; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1804 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1805 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1806 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1807 Array<Complex> z (2 * nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1808 Complex *pz = z.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1809 Array<double> rz (nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1810 double *prz = rz.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1811 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1812 F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1813 nr, tmp_data, nr, anorm, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1814 rcon, pz, prz, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1815 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1816 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1817 if (info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1818 rcon = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1819 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1820 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1821 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1822 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1823 if (typ == MatrixType::Full) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1824 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1825 octave_idx_type info = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1826 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1827 Array<octave_idx_type> ipvt (nr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1828 octave_idx_type *pipvt = ipvt.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1829 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1830 if(anorm < 0.) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1831 anorm = atmp.abs().sum(). |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1832 row(static_cast<octave_idx_type>(0)).max(); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1833 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1834 Array<Complex> z (2 * nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1835 Complex *pz = z.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1836 Array<double> rz (2 * nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1837 double *prz = rz.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1838 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1839 F77_XFCN (zgetrf, ZGETRF, (nr, nr, tmp_data, nr, pipvt, info)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1840 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1841 if (info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1842 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1843 rcon = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1844 mattype.mark_as_rectangular (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1845 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1846 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1847 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1848 char job = '1'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1849 F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1850 nc, tmp_data, nr, anorm, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1851 rcon, pz, prz, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1852 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1853 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1854 if (info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1855 rcon = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1856 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1857 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1858 } |
7788 | 1859 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1860 rcon = 0.0; |
7788 | 1861 } |
1862 | |
1863 return rcon; | |
1864 } | |
1865 | |
458 | 1866 ComplexMatrix |
5785 | 1867 ComplexMatrix::utsolve (MatrixType &mattype, const ComplexMatrix& b, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1868 octave_idx_type& info, double& rcon, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1869 solve_singularity_handler sing_handler, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1870 bool calc_cond, blas_trans_type transt) const |
5785 | 1871 { |
1872 ComplexMatrix retval; | |
1873 | |
1874 octave_idx_type nr = rows (); | |
1875 octave_idx_type nc = cols (); | |
1876 | |
6924 | 1877 if (nr != b.rows ()) |
5785 | 1878 (*current_liboctave_error_handler) |
1879 ("matrix dimension mismatch solution of linear equations"); | |
6924 | 1880 else if (nr == 0 || nc == 0 || b.cols () == 0) |
1881 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
5785 | 1882 else |
1883 { | |
1884 volatile int typ = mattype.type (); | |
1885 | |
1886 if (typ == MatrixType::Permuted_Upper || | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1887 typ == MatrixType::Upper) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1888 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1889 octave_idx_type b_nc = b.cols (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1890 rcon = 1.; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1891 info = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1892 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1893 if (typ == MatrixType::Permuted_Upper) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1894 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1895 (*current_liboctave_error_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1896 ("permuted triangular matrix not implemented"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1897 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1898 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1899 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1900 const Complex *tmp_data = fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1901 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1902 if (calc_cond) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1903 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1904 char norm = '1'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1905 char uplo = 'U'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1906 char dia = 'N'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1907 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1908 Array<Complex> z (2 * nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1909 Complex *pz = z.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1910 Array<double> rz (nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1911 double *prz = rz.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1912 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1913 F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1914 F77_CONST_CHAR_ARG2 (&uplo, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1915 F77_CONST_CHAR_ARG2 (&dia, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1916 nr, tmp_data, nr, rcon, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1917 pz, prz, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1918 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1919 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1920 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1921 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1922 if (info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1923 info = -2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1924 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1925 volatile double rcond_plus_one = rcon + 1.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1926 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1927 if (rcond_plus_one == 1.0 || xisnan (rcon)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1928 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1929 info = -2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1930 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1931 if (sing_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1932 sing_handler (rcon); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1933 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1934 (*current_liboctave_error_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1935 ("matrix singular to machine precision, rcond = %g", |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1936 rcon); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1937 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1938 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1939 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1940 if (info == 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1941 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1942 retval = b; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1943 Complex *result = retval.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1944 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1945 char uplo = 'U'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1946 char trans = get_blas_char (transt); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1947 char dia = 'N'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1948 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1949 F77_XFCN (ztrtrs, ZTRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1950 F77_CONST_CHAR_ARG2 (&trans, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1951 F77_CONST_CHAR_ARG2 (&dia, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1952 nr, b_nc, tmp_data, nr, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1953 result, nr, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1954 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1955 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1956 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1957 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1958 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1959 } |
5785 | 1960 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1961 (*current_liboctave_error_handler) ("incorrect matrix type"); |
5785 | 1962 } |
1963 | |
1964 return retval; | |
1965 } | |
1966 | |
1967 ComplexMatrix | |
1968 ComplexMatrix::ltsolve (MatrixType &mattype, const ComplexMatrix& b, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1969 octave_idx_type& info, double& rcon, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1970 solve_singularity_handler sing_handler, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1971 bool calc_cond, blas_trans_type transt) const |
5785 | 1972 { |
1973 ComplexMatrix retval; | |
1974 | |
1975 octave_idx_type nr = rows (); | |
1976 octave_idx_type nc = cols (); | |
1977 | |
6924 | 1978 if (nr != b.rows ()) |
5785 | 1979 (*current_liboctave_error_handler) |
1980 ("matrix dimension mismatch solution of linear equations"); | |
6924 | 1981 else if (nr == 0 || nc == 0 || b.cols () == 0) |
1982 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
5785 | 1983 else |
1984 { | |
1985 volatile int typ = mattype.type (); | |
1986 | |
1987 if (typ == MatrixType::Permuted_Lower || | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1988 typ == MatrixType::Lower) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1989 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1990 octave_idx_type b_nc = b.cols (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1991 rcon = 1.; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1992 info = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1993 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1994 if (typ == MatrixType::Permuted_Lower) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1995 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1996 (*current_liboctave_error_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1997 ("permuted triangular matrix not implemented"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1998 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
1999 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2000 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2001 const Complex *tmp_data = fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2002 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2003 if (calc_cond) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2004 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2005 char norm = '1'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2006 char uplo = 'L'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2007 char dia = 'N'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2008 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2009 Array<Complex> z (2 * nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2010 Complex *pz = z.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2011 Array<double> rz (nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2012 double *prz = rz.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2013 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2014 F77_XFCN (ztrcon, ZTRCON, (F77_CONST_CHAR_ARG2 (&norm, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2015 F77_CONST_CHAR_ARG2 (&uplo, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2016 F77_CONST_CHAR_ARG2 (&dia, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2017 nr, tmp_data, nr, rcon, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2018 pz, prz, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2019 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2020 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2021 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2022 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2023 if (info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2024 info = -2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2025 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2026 volatile double rcond_plus_one = rcon + 1.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2027 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2028 if (rcond_plus_one == 1.0 || xisnan (rcon)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2029 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2030 info = -2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2031 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2032 if (sing_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2033 sing_handler (rcon); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2034 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2035 (*current_liboctave_error_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2036 ("matrix singular to machine precision, rcond = %g", |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2037 rcon); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2038 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2039 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2040 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2041 if (info == 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2042 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2043 retval = b; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2044 Complex *result = retval.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2045 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2046 char uplo = 'L'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2047 char trans = get_blas_char (transt); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2048 char dia = 'N'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2049 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2050 F77_XFCN (ztrtrs, ZTRTRS, (F77_CONST_CHAR_ARG2 (&uplo, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2051 F77_CONST_CHAR_ARG2 (&trans, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2052 F77_CONST_CHAR_ARG2 (&dia, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2053 nr, b_nc, tmp_data, nr, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2054 result, nr, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2055 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2056 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2057 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2058 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2059 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2060 } |
5785 | 2061 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2062 (*current_liboctave_error_handler) ("incorrect matrix type"); |
5785 | 2063 } |
2064 | |
2065 return retval; | |
2066 } | |
2067 | |
2068 ComplexMatrix | |
2069 ComplexMatrix::fsolve (MatrixType &mattype, const ComplexMatrix& b, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2070 octave_idx_type& info, double& rcon, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2071 solve_singularity_handler sing_handler, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2072 bool calc_cond) const |
5785 | 2073 { |
2074 ComplexMatrix retval; | |
2075 | |
2076 octave_idx_type nr = rows (); | |
2077 octave_idx_type nc = cols (); | |
2078 | |
6924 | 2079 |
2080 if (nr != nc || nr != b.rows ()) | |
5785 | 2081 (*current_liboctave_error_handler) |
6924 | 2082 ("matrix dimension mismatch solution of linear equations"); |
2083 else if (nr == 0 || b.cols () == 0) | |
2084 retval = ComplexMatrix (nc, b.cols (), Complex (0.0, 0.0)); | |
5785 | 2085 else |
2086 { | |
2087 volatile int typ = mattype.type (); | |
2088 | |
2089 // Calculate the norm of the matrix, for later use. | |
2090 double anorm = -1.; | |
2091 | |
2092 if (typ == MatrixType::Hermitian) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2093 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2094 info = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2095 char job = 'L'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2096 ComplexMatrix atmp = *this; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2097 Complex *tmp_data = atmp.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2098 anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2099 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2100 F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 (&job, 1), nr, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2101 tmp_data, nr, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2102 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2103 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2104 // Throw-away extra info LAPACK gives so as to not change output. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2105 rcon = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2106 if (info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2107 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2108 info = -2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2109 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2110 mattype.mark_as_unsymmetric (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2111 typ = MatrixType::Full; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2112 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2113 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2114 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2115 if (calc_cond) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2116 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2117 Array<Complex> z (2 * nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2118 Complex *pz = z.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2119 Array<double> rz (nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2120 double *prz = rz.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2121 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2122 F77_XFCN (zpocon, ZPOCON, (F77_CONST_CHAR_ARG2 (&job, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2123 nr, tmp_data, nr, anorm, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2124 rcon, pz, prz, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2125 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2126 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2127 if (info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2128 info = -2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2129 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2130 volatile double rcond_plus_one = rcon + 1.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2131 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2132 if (rcond_plus_one == 1.0 || xisnan (rcon)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2133 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2134 info = -2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2135 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2136 if (sing_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2137 sing_handler (rcon); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2138 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2139 (*current_liboctave_error_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2140 ("matrix singular to machine precision, rcond = %g", |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2141 rcon); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2142 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2143 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2144 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2145 if (info == 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2146 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2147 retval = b; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2148 Complex *result = retval.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2149 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2150 octave_idx_type b_nc = b.cols (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2151 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2152 F77_XFCN (zpotrs, ZPOTRS, (F77_CONST_CHAR_ARG2 (&job, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2153 nr, b_nc, tmp_data, nr, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2154 result, b.rows(), info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2155 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2156 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2157 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2158 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2159 mattype.mark_as_unsymmetric (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2160 typ = MatrixType::Full; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2161 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2162 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2163 } |
5785 | 2164 |
2165 if (typ == MatrixType::Full) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2166 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2167 info = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2168 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2169 Array<octave_idx_type> ipvt (nr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2170 octave_idx_type *pipvt = ipvt.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2171 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2172 ComplexMatrix atmp = *this; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2173 Complex *tmp_data = atmp.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2174 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2175 Array<Complex> z (2 * nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2176 Complex *pz = z.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2177 Array<double> rz (2 * nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2178 double *prz = rz.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2179 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2180 // Calculate the norm of the matrix, for later use. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2181 if (anorm < 0.) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2182 anorm = atmp.abs().sum().row(static_cast<octave_idx_type>(0)).max(); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2183 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2184 F77_XFCN (zgetrf, ZGETRF, (nr, nr, tmp_data, nr, pipvt, info)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2185 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2186 // Throw-away extra info LAPACK gives so as to not change output. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2187 rcon = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2188 if (info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2189 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2190 info = -2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2191 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2192 if (sing_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2193 sing_handler (rcon); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2194 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2195 (*current_liboctave_error_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2196 ("matrix singular to machine precision"); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2197 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2198 mattype.mark_as_rectangular (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2199 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2200 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2201 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2202 if (calc_cond) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2203 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2204 // Now calculate the condition number for |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2205 // non-singular matrix. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2206 char job = '1'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2207 F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2208 nc, tmp_data, nr, anorm, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2209 rcon, pz, prz, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2210 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2211 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2212 if (info != 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2213 info = -2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2214 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2215 volatile double rcond_plus_one = rcon + 1.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2216 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2217 if (rcond_plus_one == 1.0 || xisnan (rcon)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2218 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2219 info = -2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2220 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2221 if (sing_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2222 sing_handler (rcon); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2223 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2224 (*current_liboctave_error_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2225 ("matrix singular to machine precision, rcond = %g", |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2226 rcon); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2227 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2228 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2229 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2230 if (info == 0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2231 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2232 retval = b; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2233 Complex *result = retval.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2234 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2235 octave_idx_type b_nc = b.cols (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2236 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2237 char job = 'N'; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2238 F77_XFCN (zgetrs, ZGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2239 nr, b_nc, tmp_data, nr, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2240 pipvt, result, b.rows(), info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2241 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2242 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2243 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2244 mattype.mark_as_rectangular (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2245 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2246 } |
5785 | 2247 } |
2248 | |
2249 return retval; | |
2250 } | |
2251 | |
2252 ComplexMatrix | |
2253 ComplexMatrix::solve (MatrixType &typ, const Matrix& b) const | |
2254 { | |
2255 octave_idx_type info; | |
7788 | 2256 double rcon; |
2257 return solve (typ, b, info, rcon, 0); | |
5785 | 2258 } |
2259 | |
2260 ComplexMatrix | |
2261 ComplexMatrix::solve (MatrixType &typ, const Matrix& b, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2262 octave_idx_type& info) const |
5785 | 2263 { |
7788 | 2264 double rcon; |
2265 return solve (typ, b, info, rcon, 0); | |
5785 | 2266 } |
2267 | |
2268 ComplexMatrix | |
2269 ComplexMatrix::solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2270 double& rcon) const |
5785 | 2271 { |
7788 | 2272 return solve (typ, b, info, rcon, 0); |
5785 | 2273 } |
2274 | |
2275 ComplexMatrix | |
2276 ComplexMatrix::solve (MatrixType &typ, const Matrix& b, octave_idx_type& info, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2277 double& rcon, solve_singularity_handler sing_handler, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2278 bool singular_fallback, blas_trans_type transt) const |
5785 | 2279 { |
2280 ComplexMatrix tmp (b); | |
9661
afcf852256d2
optimize / and '\ for triangular matrices
Jaroslav Hajek <highegg@gmail.com>
parents:
9658
diff
changeset
|
2281 return solve (typ, tmp, info, rcon, sing_handler, singular_fallback, transt); |
5785 | 2282 } |
2283 | |
2284 ComplexMatrix | |
2285 ComplexMatrix::solve (MatrixType &typ, const ComplexMatrix& b) const | |
2286 { | |
2287 octave_idx_type info; | |
7788 | 2288 double rcon; |
2289 return solve (typ, b, info, rcon, 0); | |
5785 | 2290 } |
2291 | |
2292 ComplexMatrix | |
2293 ComplexMatrix::solve (MatrixType &typ, const ComplexMatrix& b, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2294 octave_idx_type& info) const |
5785 | 2295 { |
7788 | 2296 double rcon; |
2297 return solve (typ, b, info, rcon, 0); | |
5785 | 2298 } |
2299 | |
2300 ComplexMatrix | |
2301 ComplexMatrix::solve (MatrixType &typ, const ComplexMatrix& b, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2302 octave_idx_type& info, double& rcon) const |
5785 | 2303 { |
7788 | 2304 return solve (typ, b, info, rcon, 0); |
5785 | 2305 } |
2306 | |
2307 ComplexMatrix | |
2308 ComplexMatrix::solve (MatrixType &mattype, const ComplexMatrix& b, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2309 octave_idx_type& info, double& rcon, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2310 solve_singularity_handler sing_handler, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2311 bool singular_fallback, blas_trans_type transt) const |
5785 | 2312 { |
2313 ComplexMatrix retval; | |
2314 int typ = mattype.type (); | |
2315 | |
2316 if (typ == MatrixType::Unknown) | |
2317 typ = mattype.type (*this); | |
2318 | |
2319 // Only calculate the condition number for LU/Cholesky | |
2320 if (typ == MatrixType::Upper || typ == MatrixType::Permuted_Upper) | |
9661
afcf852256d2
optimize / and '\ for triangular matrices
Jaroslav Hajek <highegg@gmail.com>
parents:
9658
diff
changeset
|
2321 retval = utsolve (mattype, b, info, rcon, sing_handler, false, transt); |
5785 | 2322 else if (typ == MatrixType::Lower || typ == MatrixType::Permuted_Lower) |
9661
afcf852256d2
optimize / and '\ for triangular matrices
Jaroslav Hajek <highegg@gmail.com>
parents:
9658
diff
changeset
|
2323 retval = ltsolve (mattype, b, info, rcon, sing_handler, false, transt); |
afcf852256d2
optimize / and '\ for triangular matrices
Jaroslav Hajek <highegg@gmail.com>
parents:
9658
diff
changeset
|
2324 else if (transt == blas_trans) |
afcf852256d2
optimize / and '\ for triangular matrices
Jaroslav Hajek <highegg@gmail.com>
parents:
9658
diff
changeset
|
2325 return transpose ().solve (mattype, b, info, rcon, sing_handler, singular_fallback); |
afcf852256d2
optimize / and '\ for triangular matrices
Jaroslav Hajek <highegg@gmail.com>
parents:
9658
diff
changeset
|
2326 else if (transt == blas_conj_trans) |
afcf852256d2
optimize / and '\ for triangular matrices
Jaroslav Hajek <highegg@gmail.com>
parents:
9658
diff
changeset
|
2327 retval = hermitian ().solve (mattype, b, info, rcon, sing_handler, singular_fallback); |
5785 | 2328 else if (typ == MatrixType::Full || typ == MatrixType::Hermitian) |
7788 | 2329 retval = fsolve (mattype, b, info, rcon, sing_handler, true); |
5785 | 2330 else if (typ != MatrixType::Rectangular) |
2331 { | |
2332 (*current_liboctave_error_handler) ("unknown matrix type"); | |
2333 return ComplexMatrix (); | |
2334 } | |
2335 | |
2336 // Rectangular or one of the above solvers flags a singular matrix | |
2337 if (singular_fallback && mattype.type () == MatrixType::Rectangular) | |
2338 { | |
2339 octave_idx_type rank; | |
7788 | 2340 retval = lssolve (b, info, rank, rcon); |
5785 | 2341 } |
2342 | |
2343 return retval; | |
2344 } | |
2345 | |
2346 ComplexColumnVector | |
2347 ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b) const | |
2348 { | |
2349 octave_idx_type info; | |
7788 | 2350 double rcon; |
2351 return solve (typ, ComplexColumnVector (b), info, rcon, 0); | |
5785 | 2352 } |
2353 | |
2354 ComplexColumnVector | |
2355 ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2356 octave_idx_type& info) const |
5785 | 2357 { |
7788 | 2358 double rcon; |
2359 return solve (typ, ComplexColumnVector (b), info, rcon, 0); | |
5785 | 2360 } |
2361 | |
2362 ComplexColumnVector | |
2363 ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2364 octave_idx_type& info, double& rcon) const |
5785 | 2365 { |
7788 | 2366 return solve (typ, ComplexColumnVector (b), info, rcon, 0); |
5785 | 2367 } |
2368 | |
2369 ComplexColumnVector | |
2370 ComplexMatrix::solve (MatrixType &typ, const ColumnVector& b, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2371 octave_idx_type& info, double& rcon, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2372 solve_singularity_handler sing_handler, blas_trans_type transt) const |
5785 | 2373 { |
9661
afcf852256d2
optimize / and '\ for triangular matrices
Jaroslav Hajek <highegg@gmail.com>
parents:
9658
diff
changeset
|
2374 return solve (typ, ComplexColumnVector (b), info, rcon, sing_handler, transt); |
5785 | 2375 } |
2376 | |
2377 ComplexColumnVector | |
2378 ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b) const | |
2379 { | |
2380 octave_idx_type info; | |
7788 | 2381 double rcon; |
2382 return solve (typ, b, info, rcon, 0); | |
5785 | 2383 } |
2384 | |
2385 ComplexColumnVector | |
2386 ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2387 octave_idx_type& info) const |
5785 | 2388 { |
7788 | 2389 double rcon; |
2390 return solve (typ, b, info, rcon, 0); | |
5785 | 2391 } |
2392 | |
2393 ComplexColumnVector | |
2394 ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2395 octave_idx_type& info, double& rcon) const |
5785 | 2396 { |
7788 | 2397 return solve (typ, b, info, rcon, 0); |
5785 | 2398 } |
2399 | |
2400 ComplexColumnVector | |
2401 ComplexMatrix::solve (MatrixType &typ, const ComplexColumnVector& b, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2402 octave_idx_type& info, double& rcon, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2403 solve_singularity_handler sing_handler, blas_trans_type transt) const |
5785 | 2404 { |
2405 | |
2406 ComplexMatrix tmp (b); | |
9661
afcf852256d2
optimize / and '\ for triangular matrices
Jaroslav Hajek <highegg@gmail.com>
parents:
9658
diff
changeset
|
2407 return solve (typ, tmp, info, rcon, sing_handler, transt).column(static_cast<octave_idx_type> (0)); |
5785 | 2408 } |
2409 | |
2410 ComplexMatrix | |
458 | 2411 ComplexMatrix::solve (const Matrix& b) const |
2412 { | |
5275 | 2413 octave_idx_type info; |
7788 | 2414 double rcon; |
2415 return solve (b, info, rcon, 0); | |
458 | 2416 } |
2417 | |
2418 ComplexMatrix | |
5275 | 2419 ComplexMatrix::solve (const Matrix& b, octave_idx_type& info) const |
458 | 2420 { |
7788 | 2421 double rcon; |
2422 return solve (b, info, rcon, 0); | |
458 | 2423 } |
2424 | |
2425 ComplexMatrix | |
7788 | 2426 ComplexMatrix::solve (const Matrix& b, octave_idx_type& info, double& rcon) const |
458 | 2427 { |
7788 | 2428 return solve (b, info, rcon, 0); |
3480 | 2429 } |
2430 | |
2431 ComplexMatrix | |
7788 | 2432 ComplexMatrix::solve (const Matrix& b, octave_idx_type& info, double& rcon, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2433 solve_singularity_handler sing_handler, blas_trans_type transt) const |
3480 | 2434 { |
458 | 2435 ComplexMatrix tmp (b); |
9661
afcf852256d2
optimize / and '\ for triangular matrices
Jaroslav Hajek <highegg@gmail.com>
parents:
9658
diff
changeset
|
2436 return solve (tmp, info, rcon, sing_handler, transt); |
458 | 2437 } |
2438 | |
2439 ComplexMatrix | |
2440 ComplexMatrix::solve (const ComplexMatrix& b) const | |
2441 { | |
5275 | 2442 octave_idx_type info; |
7788 | 2443 double rcon; |
2444 return solve (b, info, rcon, 0); | |
458 | 2445 } |
2446 | |
2447 ComplexMatrix | |
5275 | 2448 ComplexMatrix::solve (const ComplexMatrix& b, octave_idx_type& info) const |
458 | 2449 { |
7788 | 2450 double rcon; |
2451 return solve (b, info, rcon, 0); | |
458 | 2452 } |
3480 | 2453 |
458 | 2454 ComplexMatrix |
7788 | 2455 ComplexMatrix::solve (const ComplexMatrix& b, octave_idx_type& info, double& rcon) const |
458 | 2456 { |
7788 | 2457 return solve (b, info, rcon, 0); |
3480 | 2458 } |
2459 | |
2460 ComplexMatrix | |
7788 | 2461 ComplexMatrix::solve (const ComplexMatrix& b, octave_idx_type& info, double& rcon, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2462 solve_singularity_handler sing_handler, blas_trans_type transt) const |
3480 | 2463 { |
5785 | 2464 MatrixType mattype (*this); |
9661
afcf852256d2
optimize / and '\ for triangular matrices
Jaroslav Hajek <highegg@gmail.com>
parents:
9658
diff
changeset
|
2465 return solve (mattype, b, info, rcon, sing_handler, true, transt); |
458 | 2466 } |
2467 | |
2468 ComplexColumnVector | |
3585 | 2469 ComplexMatrix::solve (const ColumnVector& b) const |
2470 { | |
5275 | 2471 octave_idx_type info; |
7788 | 2472 double rcon; |
2473 return solve (ComplexColumnVector (b), info, rcon, 0); | |
3585 | 2474 } |
2475 | |
2476 ComplexColumnVector | |
5275 | 2477 ComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info) const |
3585 | 2478 { |
7788 | 2479 double rcon; |
2480 return solve (ComplexColumnVector (b), info, rcon, 0); | |
3585 | 2481 } |
2482 | |
2483 ComplexColumnVector | |
5785 | 2484 ComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2485 double& rcon) const |
3585 | 2486 { |
7788 | 2487 return solve (ComplexColumnVector (b), info, rcon, 0); |
3585 | 2488 } |
2489 | |
2490 ComplexColumnVector | |
5785 | 2491 ComplexMatrix::solve (const ColumnVector& b, octave_idx_type& info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2492 double& rcon, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2493 solve_singularity_handler sing_handler, blas_trans_type transt) const |
3585 | 2494 { |
9661
afcf852256d2
optimize / and '\ for triangular matrices
Jaroslav Hajek <highegg@gmail.com>
parents:
9658
diff
changeset
|
2495 return solve (ComplexColumnVector (b), info, rcon, sing_handler, transt); |
3585 | 2496 } |
2497 | |
2498 ComplexColumnVector | |
458 | 2499 ComplexMatrix::solve (const ComplexColumnVector& b) const |
2500 { | |
5275 | 2501 octave_idx_type info; |
7788 | 2502 double rcon; |
2503 return solve (b, info, rcon, 0); | |
458 | 2504 } |
2505 | |
2506 ComplexColumnVector | |
5275 | 2507 ComplexMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info) const |
458 | 2508 { |
7788 | 2509 double rcon; |
2510 return solve (b, info, rcon, 0); | |
458 | 2511 } |
2512 | |
2513 ComplexColumnVector | |
5275 | 2514 ComplexMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2515 double& rcon) const |
458 | 2516 { |
7788 | 2517 return solve (b, info, rcon, 0); |
3480 | 2518 } |
2519 | |
2520 ComplexColumnVector | |
5275 | 2521 ComplexMatrix::solve (const ComplexColumnVector& b, octave_idx_type& info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2522 double& rcon, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2523 solve_singularity_handler sing_handler, blas_trans_type transt) const |
3480 | 2524 { |
5785 | 2525 MatrixType mattype (*this); |
9661
afcf852256d2
optimize / and '\ for triangular matrices
Jaroslav Hajek <highegg@gmail.com>
parents:
9658
diff
changeset
|
2526 return solve (mattype, b, info, rcon, sing_handler, transt); |
458 | 2527 } |
2528 | |
2529 ComplexMatrix | |
3585 | 2530 ComplexMatrix::lssolve (const Matrix& b) const |
2531 { | |
5275 | 2532 octave_idx_type info; |
2533 octave_idx_type rank; | |
7788 | 2534 double rcon; |
2535 return lssolve (ComplexMatrix (b), info, rank, rcon); | |
3585 | 2536 } |
2537 | |
2538 ComplexMatrix | |
5275 | 2539 ComplexMatrix::lssolve (const Matrix& b, octave_idx_type& info) const |
3585 | 2540 { |
5275 | 2541 octave_idx_type rank; |
7788 | 2542 double rcon; |
2543 return lssolve (ComplexMatrix (b), info, rank, rcon); | |
3585 | 2544 } |
2545 | |
2546 ComplexMatrix | |
7076 | 2547 ComplexMatrix::lssolve (const Matrix& b, octave_idx_type& info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2548 octave_idx_type& rank) const |
3585 | 2549 { |
7788 | 2550 double rcon; |
2551 return lssolve (ComplexMatrix (b), info, rank, rcon); | |
7076 | 2552 } |
2553 | |
2554 ComplexMatrix | |
2555 ComplexMatrix::lssolve (const Matrix& b, octave_idx_type& info, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2556 octave_idx_type& rank, double& rcon) const |
7076 | 2557 { |
7788 | 2558 return lssolve (ComplexMatrix (b), info, rank, rcon); |
3585 | 2559 } |
2560 | |
2561 ComplexMatrix | |
458 | 2562 ComplexMatrix::lssolve (const ComplexMatrix& b) const |
2563 { | |
5275 | 2564 octave_idx_type info; |
2565 octave_idx_type rank; | |
7788 | 2566 double rcon; |
2567 return lssolve (b, info, rank, rcon); | |
458 | 2568 } |
2569 | |
2570 ComplexMatrix | |
5275 | 2571 ComplexMatrix::lssolve (const ComplexMatrix& b, octave_idx_type& info) const |
458 | 2572 { |
5275 | 2573 octave_idx_type rank; |
7788 | 2574 double rcon; |
2575 return lssolve (b, info, rank, rcon); | |
458 | 2576 } |
2577 | |
2578 ComplexMatrix | |
7076 | 2579 ComplexMatrix::lssolve (const ComplexMatrix& b, octave_idx_type& info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2580 octave_idx_type& rank) const |
7076 | 2581 { |
7788 | 2582 double rcon; |
2583 return lssolve (b, info, rank, rcon); | |
7076 | 2584 } |
2585 | |
2586 ComplexMatrix | |
2587 ComplexMatrix::lssolve (const ComplexMatrix& b, octave_idx_type& info, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2588 octave_idx_type& rank, double& rcon) const |
458 | 2589 { |
1948 | 2590 ComplexMatrix retval; |
2591 | |
5275 | 2592 octave_idx_type nrhs = b.cols (); |
2593 | |
2594 octave_idx_type m = rows (); | |
2595 octave_idx_type n = cols (); | |
458 | 2596 |
6924 | 2597 if (m != b.rows ()) |
1948 | 2598 (*current_liboctave_error_handler) |
2599 ("matrix dimension mismatch solution of linear equations"); | |
6924 | 2600 else if (m== 0 || n == 0 || b.cols () == 0) |
2601 retval = ComplexMatrix (n, b.cols (), Complex (0.0, 0.0)); | |
1948 | 2602 else |
458 | 2603 { |
7072 | 2604 volatile octave_idx_type minmn = (m < n ? m : n); |
2605 octave_idx_type maxmn = m > n ? m : n; | |
7788 | 2606 rcon = -1.0; |
7072 | 2607 |
2608 if (m != n) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2609 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2610 retval = ComplexMatrix (maxmn, nrhs); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2611 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2612 for (octave_idx_type j = 0; j < nrhs; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2613 for (octave_idx_type i = 0; i < m; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2614 retval.elem (i, j) = b.elem (i, j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2615 } |
7072 | 2616 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2617 retval = b; |
7072 | 2618 |
1948 | 2619 ComplexMatrix atmp = *this; |
2620 Complex *tmp_data = atmp.fortran_vec (); | |
2621 | |
7072 | 2622 Complex *pretval = retval.fortran_vec (); |
2623 Array<double> s (minmn); | |
7071 | 2624 double *ps = s.fortran_vec (); |
2563 | 2625 |
7072 | 2626 // Ask ZGELSD what the dimension of WORK should be. |
5275 | 2627 octave_idx_type lwork = -1; |
3752 | 2628 |
2629 Array<Complex> work (1); | |
7079 | 2630 |
7477 | 2631 octave_idx_type smlsiz; |
2632 F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("ZGELSD", 6), | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2633 F77_CONST_CHAR_ARG2 (" ", 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2634 0, 0, 0, 0, smlsiz |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2635 F77_CHAR_ARG_LEN (6) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2636 F77_CHAR_ARG_LEN (1)); |
7079 | 2637 |
7486
6a6d2abe51ff
more xGELSD workspace fixes
John W. Eaton <jwe@octave.org>
parents:
7482
diff
changeset
|
2638 octave_idx_type mnthr; |
6a6d2abe51ff
more xGELSD workspace fixes
John W. Eaton <jwe@octave.org>
parents:
7482
diff
changeset
|
2639 F77_FUNC (xilaenv, XILAENV) (6, F77_CONST_CHAR_ARG2 ("ZGELSD", 6), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2640 F77_CONST_CHAR_ARG2 (" ", 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2641 m, n, nrhs, -1, mnthr |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2642 F77_CHAR_ARG_LEN (6) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2643 F77_CHAR_ARG_LEN (1)); |
7486
6a6d2abe51ff
more xGELSD workspace fixes
John W. Eaton <jwe@octave.org>
parents:
7482
diff
changeset
|
2644 |
7079 | 2645 // We compute the size of rwork and iwork because ZGELSD in |
2646 // older versions of LAPACK does not return them on a query | |
2647 // call. | |
7124 | 2648 double dminmn = static_cast<double> (minmn); |
2649 double dsmlsizp1 = static_cast<double> (smlsiz+1); | |
7079 | 2650 #if defined (HAVE_LOG2) |
7544
f9983d2761df
more xGELSD workspace fixes
Jaroslav Hajek <highegg@gmail.com>
parents:
7532
diff
changeset
|
2651 double tmp = log2 (dminmn / dsmlsizp1); |
7079 | 2652 #else |
7544
f9983d2761df
more xGELSD workspace fixes
Jaroslav Hajek <highegg@gmail.com>
parents:
7532
diff
changeset
|
2653 double tmp = log (dminmn / dsmlsizp1) / log (2.0); |
7079 | 2654 #endif |
7544
f9983d2761df
more xGELSD workspace fixes
Jaroslav Hajek <highegg@gmail.com>
parents:
7532
diff
changeset
|
2655 octave_idx_type nlvl = static_cast<octave_idx_type> (tmp) + 1; |
7079 | 2656 if (nlvl < 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2657 nlvl = 0; |
7079 | 2658 |
2659 octave_idx_type lrwork = minmn*(10 + 2*smlsiz + 8*nlvl) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2660 + 3*smlsiz*nrhs + (smlsiz+1)*(smlsiz+1); |
7079 | 2661 if (lrwork < 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2662 lrwork = 1; |
7079 | 2663 Array<double> rwork (lrwork); |
2664 double *prwork = rwork.fortran_vec (); | |
2665 | |
2666 octave_idx_type liwork = 3 * minmn * nlvl + 11 * minmn; | |
2667 if (liwork < 1) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2668 liwork = 1; |
7079 | 2669 Array<octave_idx_type> iwork (liwork); |
2670 octave_idx_type* piwork = iwork.fortran_vec (); | |
7072 | 2671 |
2672 F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2673 ps, rcon, rank, work.fortran_vec (), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2674 lwork, prwork, piwork, info)); |
1948 | 2675 |
7476 | 2676 // The workspace query is broken in at least LAPACK 3.0.0 |
7488
6470f946a425
another small xGELSD workspace fix
John W. Eaton <jwe@octave.org>
parents:
7486
diff
changeset
|
2677 // through 3.1.1 when n >= mnthr. The obtuse formula below |
7486
6a6d2abe51ff
more xGELSD workspace fixes
John W. Eaton <jwe@octave.org>
parents:
7482
diff
changeset
|
2678 // should provide sufficient workspace for ZGELSD to operate |
7476 | 2679 // efficiently. |
7488
6470f946a425
another small xGELSD workspace fix
John W. Eaton <jwe@octave.org>
parents:
7486
diff
changeset
|
2680 if (n >= mnthr) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2681 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2682 octave_idx_type addend = m; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2683 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2684 if (2*m-4 > addend) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2685 addend = 2*m-4; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2686 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2687 if (nrhs > addend) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2688 addend = nrhs; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2689 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2690 if (n-3*m > addend) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2691 addend = n-3*m; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2692 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2693 const octave_idx_type lworkaround = 4*m + m*m + addend; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2694 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2695 if (std::real (work(0)) < lworkaround) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2696 work(0) = lworkaround; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2697 } |
7532
493bb0de3199
avoid another xGELSD workspace query bug
John W. Eaton <jwe@octave.org>
parents:
7503
diff
changeset
|
2698 else if (m >= n) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2699 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2700 octave_idx_type lworkaround = 2*m + m*nrhs; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2701 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2702 if (std::real (work(0)) < lworkaround) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2703 work(0) = lworkaround; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2704 } |
7476 | 2705 |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2706 lwork = static_cast<octave_idx_type> (std::real (work(0))); |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2707 work.resize (lwork); |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2708 |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2709 F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2710 maxmn, ps, rcon, rank, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2711 work.fortran_vec (), lwork, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2712 prwork, piwork, info)); |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2713 |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2714 if (rank < minmn) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2715 (*current_liboctave_warning_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2716 ("zgelsd: rank deficient %dx%d matrix, rank = %d, tol = %e", |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2717 m, n, rank, rcon); |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2718 |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2719 if (s.elem (0) == 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2720 rcon = 0.0; |
1948 | 2721 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2722 rcon = s.elem (minmn - 1) / s.elem (0); |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2723 |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2724 retval.resize (n, nrhs); |
458 | 2725 } |
2726 | |
2727 return retval; | |
2728 } | |
2729 | |
2730 ComplexColumnVector | |
3585 | 2731 ComplexMatrix::lssolve (const ColumnVector& b) const |
2732 { | |
5275 | 2733 octave_idx_type info; |
2734 octave_idx_type rank; | |
7788 | 2735 double rcon; |
2736 return lssolve (ComplexColumnVector (b), info, rank, rcon); | |
3585 | 2737 } |
2738 | |
2739 ComplexColumnVector | |
5275 | 2740 ComplexMatrix::lssolve (const ColumnVector& b, octave_idx_type& info) const |
3585 | 2741 { |
5275 | 2742 octave_idx_type rank; |
7788 | 2743 double rcon; |
2744 return lssolve (ComplexColumnVector (b), info, rank, rcon); | |
3585 | 2745 } |
2746 | |
2747 ComplexColumnVector | |
7076 | 2748 ComplexMatrix::lssolve (const ColumnVector& b, octave_idx_type& info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2749 octave_idx_type& rank) const |
3585 | 2750 { |
7788 | 2751 double rcon; |
2752 return lssolve (ComplexColumnVector (b), info, rank, rcon); | |
7076 | 2753 } |
2754 | |
2755 ComplexColumnVector | |
2756 ComplexMatrix::lssolve (const ColumnVector& b, octave_idx_type& info, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2757 octave_idx_type& rank, double& rcon) const |
7076 | 2758 { |
7788 | 2759 return lssolve (ComplexColumnVector (b), info, rank, rcon); |
3585 | 2760 } |
2761 | |
2762 ComplexColumnVector | |
458 | 2763 ComplexMatrix::lssolve (const ComplexColumnVector& b) const |
2764 { | |
5275 | 2765 octave_idx_type info; |
2766 octave_idx_type rank; | |
7788 | 2767 double rcon; |
2768 return lssolve (b, info, rank, rcon); | |
458 | 2769 } |
2770 | |
2771 ComplexColumnVector | |
5275 | 2772 ComplexMatrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info) const |
458 | 2773 { |
5275 | 2774 octave_idx_type rank; |
7788 | 2775 double rcon; |
2776 return lssolve (b, info, rank, rcon); | |
458 | 2777 } |
2778 | |
2779 ComplexColumnVector | |
5275 | 2780 ComplexMatrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2781 octave_idx_type& rank) const |
458 | 2782 { |
7788 | 2783 double rcon; |
2784 return lssolve (b, info, rank, rcon); | |
7076 | 2785 |
2786 } | |
2787 | |
2788 ComplexColumnVector | |
2789 ComplexMatrix::lssolve (const ComplexColumnVector& b, octave_idx_type& info, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2790 octave_idx_type& rank, double& rcon) const |
7076 | 2791 { |
1948 | 2792 ComplexColumnVector retval; |
2793 | |
5275 | 2794 octave_idx_type nrhs = 1; |
2795 | |
2796 octave_idx_type m = rows (); | |
2797 octave_idx_type n = cols (); | |
458 | 2798 |
6924 | 2799 if (m != b.length ()) |
1948 | 2800 (*current_liboctave_error_handler) |
6924 | 2801 ("matrix dimension mismatch solution of linear equations"); |
2802 else if (m == 0 || n == 0 || b.cols () == 0) | |
2803 retval = ComplexColumnVector (n, Complex (0.0, 0.0)); | |
1948 | 2804 else |
458 | 2805 { |
7072 | 2806 volatile octave_idx_type minmn = (m < n ? m : n); |
2807 octave_idx_type maxmn = m > n ? m : n; | |
7788 | 2808 rcon = -1.0; |
7072 | 2809 |
2810 if (m != n) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2811 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2812 retval = ComplexColumnVector (maxmn); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2813 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2814 for (octave_idx_type i = 0; i < m; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2815 retval.elem (i) = b.elem (i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2816 } |
7072 | 2817 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2818 retval = b; |
7072 | 2819 |
1948 | 2820 ComplexMatrix atmp = *this; |
2821 Complex *tmp_data = atmp.fortran_vec (); | |
2822 | |
7072 | 2823 Complex *pretval = retval.fortran_vec (); |
2824 Array<double> s (minmn); | |
7071 | 2825 double *ps = s.fortran_vec (); |
1948 | 2826 |
7072 | 2827 // Ask ZGELSD what the dimension of WORK should be. |
5275 | 2828 octave_idx_type lwork = -1; |
3752 | 2829 |
2830 Array<Complex> work (1); | |
7079 | 2831 |
7544
f9983d2761df
more xGELSD workspace fixes
Jaroslav Hajek <highegg@gmail.com>
parents:
7532
diff
changeset
|
2832 octave_idx_type smlsiz; |
f9983d2761df
more xGELSD workspace fixes
Jaroslav Hajek <highegg@gmail.com>
parents:
7532
diff
changeset
|
2833 F77_FUNC (xilaenv, XILAENV) (9, F77_CONST_CHAR_ARG2 ("ZGELSD", 6), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2834 F77_CONST_CHAR_ARG2 (" ", 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2835 0, 0, 0, 0, smlsiz |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2836 F77_CHAR_ARG_LEN (6) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2837 F77_CHAR_ARG_LEN (1)); |
7079 | 2838 |
2839 // We compute the size of rwork and iwork because ZGELSD in | |
2840 // older versions of LAPACK does not return them on a query | |
2841 // call. | |
7124 | 2842 double dminmn = static_cast<double> (minmn); |
2843 double dsmlsizp1 = static_cast<double> (smlsiz+1); | |
7079 | 2844 #if defined (HAVE_LOG2) |
7544
f9983d2761df
more xGELSD workspace fixes
Jaroslav Hajek <highegg@gmail.com>
parents:
7532
diff
changeset
|
2845 double tmp = log2 (dminmn / dsmlsizp1); |
7079 | 2846 #else |
7544
f9983d2761df
more xGELSD workspace fixes
Jaroslav Hajek <highegg@gmail.com>
parents:
7532
diff
changeset
|
2847 double tmp = log (dminmn / dsmlsizp1) / log (2.0); |
7079 | 2848 #endif |
7544
f9983d2761df
more xGELSD workspace fixes
Jaroslav Hajek <highegg@gmail.com>
parents:
7532
diff
changeset
|
2849 octave_idx_type nlvl = static_cast<octave_idx_type> (tmp) + 1; |
7079 | 2850 if (nlvl < 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2851 nlvl = 0; |
7079 | 2852 |
2853 octave_idx_type lrwork = minmn*(10 + 2*smlsiz + 8*nlvl) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2854 + 3*smlsiz*nrhs + (smlsiz+1)*(smlsiz+1); |
7079 | 2855 if (lrwork < 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2856 lrwork = 1; |
7079 | 2857 Array<double> rwork (lrwork); |
2858 double *prwork = rwork.fortran_vec (); | |
2859 | |
2860 octave_idx_type liwork = 3 * minmn * nlvl + 11 * minmn; | |
2861 if (liwork < 1) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2862 liwork = 1; |
7079 | 2863 Array<octave_idx_type> iwork (liwork); |
2864 octave_idx_type* piwork = iwork.fortran_vec (); | |
7072 | 2865 |
2866 F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, maxmn, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2867 ps, rcon, rank, work.fortran_vec (), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2868 lwork, prwork, piwork, info)); |
1948 | 2869 |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2870 lwork = static_cast<octave_idx_type> (std::real (work(0))); |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2871 work.resize (lwork); |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2872 rwork.resize (static_cast<octave_idx_type> (rwork(0))); |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2873 iwork.resize (iwork(0)); |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2874 |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2875 F77_XFCN (zgelsd, ZGELSD, (m, n, nrhs, tmp_data, m, pretval, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2876 maxmn, ps, rcon, rank, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2877 work.fortran_vec (), lwork, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2878 prwork, piwork, info)); |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2879 |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
2880 if (rank < minmn) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2881 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2882 if (rank < minmn) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2883 (*current_liboctave_warning_handler) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2884 ("zgelsd: rank deficient %dx%d matrix, rank = %d, tol = %e", |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2885 m, n, rank, rcon); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2886 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2887 if (s.elem (0) == 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2888 rcon = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2889 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2890 rcon = s.elem (minmn - 1) / s.elem (0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2891 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2892 retval.resize (n, nrhs); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2893 } |
458 | 2894 } |
2895 | |
2896 return retval; | |
2897 } | |
2898 | |
1205 | 2899 // column vector by row vector -> matrix operations |
2900 | |
2901 ComplexMatrix | |
2902 operator * (const ColumnVector& v, const ComplexRowVector& a) | |
2903 { | |
2904 ComplexColumnVector tmp (v); | |
2905 return tmp * a; | |
2906 } | |
2907 | |
2908 ComplexMatrix | |
2909 operator * (const ComplexColumnVector& a, const RowVector& b) | |
2910 { | |
2911 ComplexRowVector tmp (b); | |
2912 return a * tmp; | |
2913 } | |
2914 | |
2915 ComplexMatrix | |
2916 operator * (const ComplexColumnVector& v, const ComplexRowVector& a) | |
2917 { | |
1948 | 2918 ComplexMatrix retval; |
2919 | |
5275 | 2920 octave_idx_type len = v.length (); |
3233 | 2921 |
2922 if (len != 0) | |
1205 | 2923 { |
5275 | 2924 octave_idx_type a_len = a.length (); |
3233 | 2925 |
9359
be6867ba8104
avoid useless zero initialization when doing matrix multiply
Jaroslav Hajek <highegg@gmail.com>
parents:
9227
diff
changeset
|
2926 retval = ComplexMatrix (len, a_len); |
3233 | 2927 Complex *c = retval.fortran_vec (); |
2928 | |
4552 | 2929 F77_XFCN (zgemm, ZGEMM, (F77_CONST_CHAR_ARG2 ("N", 1), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2930 F77_CONST_CHAR_ARG2 ("N", 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2931 len, a_len, 1, 1.0, v.data (), len, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2932 a.data (), 1, 0.0, c, len |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2933 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
2934 F77_CHAR_ARG_LEN (1))); |
1205 | 2935 } |
2936 | |
1948 | 2937 return retval; |
1205 | 2938 } |
2939 | |
458 | 2940 // matrix by diagonal matrix -> matrix operations |
2941 | |
2942 ComplexMatrix& | |
2943 ComplexMatrix::operator += (const DiagMatrix& a) | |
2944 { | |
5275 | 2945 octave_idx_type nr = rows (); |
2946 octave_idx_type nc = cols (); | |
2947 | |
2948 octave_idx_type a_nr = rows (); | |
2949 octave_idx_type a_nc = cols (); | |
2384 | 2950 |
2951 if (nr != a_nr || nc != a_nc) | |
458 | 2952 { |
2384 | 2953 gripe_nonconformant ("operator +=", nr, nc, a_nr, a_nc); |
889 | 2954 return *this; |
458 | 2955 } |
2956 | |
5275 | 2957 for (octave_idx_type i = 0; i < a.length (); i++) |
458 | 2958 elem (i, i) += a.elem (i, i); |
2959 | |
2960 return *this; | |
2961 } | |
2962 | |
2963 ComplexMatrix& | |
2964 ComplexMatrix::operator -= (const DiagMatrix& a) | |
2965 { | |
5275 | 2966 octave_idx_type nr = rows (); |
2967 octave_idx_type nc = cols (); | |
2968 | |
2969 octave_idx_type a_nr = rows (); | |
2970 octave_idx_type a_nc = cols (); | |
2384 | 2971 |
2972 if (nr != a_nr || nc != a_nc) | |
458 | 2973 { |
2384 | 2974 gripe_nonconformant ("operator -=", nr, nc, a_nr, a_nc); |
889 | 2975 return *this; |
458 | 2976 } |
2977 | |
5275 | 2978 for (octave_idx_type i = 0; i < a.length (); i++) |
458 | 2979 elem (i, i) -= a.elem (i, i); |
2980 | |
2981 return *this; | |
2982 } | |
2983 | |
2984 ComplexMatrix& | |
2985 ComplexMatrix::operator += (const ComplexDiagMatrix& a) | |
2986 { | |
5275 | 2987 octave_idx_type nr = rows (); |
2988 octave_idx_type nc = cols (); | |
2989 | |
2990 octave_idx_type a_nr = rows (); | |
2991 octave_idx_type a_nc = cols (); | |
2384 | 2992 |
2993 if (nr != a_nr || nc != a_nc) | |
458 | 2994 { |
2384 | 2995 gripe_nonconformant ("operator +=", nr, nc, a_nr, a_nc); |
889 | 2996 return *this; |
458 | 2997 } |
2998 | |
5275 | 2999 for (octave_idx_type i = 0; i < a.length (); i++) |
458 | 3000 elem (i, i) += a.elem (i, i); |
3001 | |
3002 return *this; | |
3003 } | |
3004 | |
3005 ComplexMatrix& | |
3006 ComplexMatrix::operator -= (const ComplexDiagMatrix& a) | |
3007 { | |
5275 | 3008 octave_idx_type nr = rows (); |
3009 octave_idx_type nc = cols (); | |
3010 | |
3011 octave_idx_type a_nr = rows (); | |
3012 octave_idx_type a_nc = cols (); | |
2384 | 3013 |
3014 if (nr != a_nr || nc != a_nc) | |
458 | 3015 { |
2384 | 3016 gripe_nonconformant ("operator -=", nr, nc, a_nr, a_nc); |
889 | 3017 return *this; |
458 | 3018 } |
3019 | |
5275 | 3020 for (octave_idx_type i = 0; i < a.length (); i++) |
458 | 3021 elem (i, i) -= a.elem (i, i); |
3022 | |
3023 return *this; | |
3024 } | |
3025 | |
3026 // matrix by matrix -> matrix operations | |
3027 | |
3028 ComplexMatrix& | |
3029 ComplexMatrix::operator += (const Matrix& a) | |
3030 { | |
5275 | 3031 octave_idx_type nr = rows (); |
3032 octave_idx_type nc = cols (); | |
3033 | |
3034 octave_idx_type a_nr = a.rows (); | |
3035 octave_idx_type a_nc = a.cols (); | |
2384 | 3036 |
3037 if (nr != a_nr || nc != a_nc) | |
458 | 3038 { |
2384 | 3039 gripe_nonconformant ("operator +=", nr, nc, a_nr, a_nc); |
458 | 3040 return *this; |
3041 } | |
3042 | |
3043 if (nr == 0 || nc == 0) | |
3044 return *this; | |
3045 | |
3046 Complex *d = fortran_vec (); // Ensures only one reference to my privates! | |
3047 | |
9550
3d6a9aea2aea
refactor binary & bool ops in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9528
diff
changeset
|
3048 mx_inline_add2 (length (), d, a.data ()); |
458 | 3049 return *this; |
3050 } | |
3051 | |
3052 ComplexMatrix& | |
3053 ComplexMatrix::operator -= (const Matrix& a) | |
3054 { | |
5275 | 3055 octave_idx_type nr = rows (); |
3056 octave_idx_type nc = cols (); | |
3057 | |
3058 octave_idx_type a_nr = a.rows (); | |
3059 octave_idx_type a_nc = a.cols (); | |
2384 | 3060 |
3061 if (nr != a_nr || nc != a_nc) | |
458 | 3062 { |
2384 | 3063 gripe_nonconformant ("operator -=", nr, nc, a_nr, a_nc); |
458 | 3064 return *this; |
3065 } | |
3066 | |
3067 if (nr == 0 || nc == 0) | |
3068 return *this; | |
3069 | |
3070 Complex *d = fortran_vec (); // Ensures only one reference to my privates! | |
3071 | |
9550
3d6a9aea2aea
refactor binary & bool ops in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9528
diff
changeset
|
3072 mx_inline_sub2 (length (), d, a.data ()); |
458 | 3073 return *this; |
3074 } | |
3075 | |
3076 // unary operations | |
3077 | |
2964 | 3078 boolMatrix |
458 | 3079 ComplexMatrix::operator ! (void) const |
3080 { | |
9553
0c72d9284087
further bool ops tweaks
Jaroslav Hajek <highegg@gmail.com>
parents:
9551
diff
changeset
|
3081 return do_mx_unary_op<boolMatrix, ComplexMatrix> (*this, mx_inline_not); |
458 | 3082 } |
3083 | |
3084 // other operations | |
3085 | |
2384 | 3086 bool |
7922
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3087 ComplexMatrix::any_element_is_nan (void) const |
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3088 { |
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3089 octave_idx_type nr = rows (); |
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3090 octave_idx_type nc = cols (); |
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3091 |
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3092 for (octave_idx_type j = 0; j < nc; j++) |
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3093 for (octave_idx_type i = 0; i < nr; i++) |
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3094 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3095 Complex val = elem (i, j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3096 if (xisnan (val)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3097 return true; |
7922
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3098 } |
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3099 |
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3100 return false; |
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3101 } |
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3102 |
935be827eaf8
error for NaN values in & and | expressions
John W. Eaton <jwe@octave.org>
parents:
7803
diff
changeset
|
3103 bool |
2384 | 3104 ComplexMatrix::any_element_is_inf_or_nan (void) const |
3105 { | |
5275 | 3106 octave_idx_type nr = rows (); |
3107 octave_idx_type nc = cols (); | |
3108 | |
3109 for (octave_idx_type j = 0; j < nc; j++) | |
3110 for (octave_idx_type i = 0; i < nr; i++) | |
2384 | 3111 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3112 Complex val = elem (i, j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3113 if (xisinf (val) || xisnan (val)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3114 return true; |
2384 | 3115 } |
3116 | |
3117 return false; | |
3118 } | |
3119 | |
2408 | 3120 // Return true if no elements have imaginary components. |
3121 | |
3122 bool | |
3123 ComplexMatrix::all_elements_are_real (void) const | |
3124 { | |
9825
7483fe200fab
narrow complex values with negative zero imaginary parts
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3125 return mx_inline_all_real (numel (), data ()); |
2408 | 3126 } |
3127 | |
1968 | 3128 // Return nonzero if any element of CM has a non-integer real or |
3129 // imaginary part. Also extract the largest and smallest (real or | |
3130 // imaginary) values and return them in MAX_VAL and MIN_VAL. | |
3131 | |
2384 | 3132 bool |
1968 | 3133 ComplexMatrix::all_integers (double& max_val, double& min_val) const |
3134 { | |
5275 | 3135 octave_idx_type nr = rows (); |
3136 octave_idx_type nc = cols (); | |
1968 | 3137 |
3138 if (nr > 0 && nc > 0) | |
3139 { | |
3140 Complex val = elem (0, 0); | |
3141 | |
5315 | 3142 double r_val = std::real (val); |
3143 double i_val = std::imag (val); | |
1968 | 3144 |
3145 max_val = r_val; | |
3146 min_val = r_val; | |
3147 | |
3148 if (i_val > max_val) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3149 max_val = i_val; |
1968 | 3150 |
3151 if (i_val < max_val) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3152 min_val = i_val; |
1968 | 3153 } |
3154 else | |
2384 | 3155 return false; |
1968 | 3156 |
5275 | 3157 for (octave_idx_type j = 0; j < nc; j++) |
3158 for (octave_idx_type i = 0; i < nr; i++) | |
1968 | 3159 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3160 Complex val = elem (i, j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3161 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3162 double r_val = std::real (val); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3163 double i_val = std::imag (val); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3164 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3165 if (r_val > max_val) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3166 max_val = r_val; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3167 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3168 if (i_val > max_val) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3169 max_val = i_val; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3170 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3171 if (r_val < min_val) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3172 min_val = r_val; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3173 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3174 if (i_val < min_val) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3175 min_val = i_val; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3176 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3177 if (D_NINT (r_val) != r_val || D_NINT (i_val) != i_val) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3178 return false; |
1968 | 3179 } |
2384 | 3180 |
3181 return true; | |
1968 | 3182 } |
3183 | |
2384 | 3184 bool |
1968 | 3185 ComplexMatrix::too_large_for_float (void) const |
3186 { | |
5275 | 3187 octave_idx_type nr = rows (); |
3188 octave_idx_type nc = cols (); | |
3189 | |
3190 for (octave_idx_type j = 0; j < nc; j++) | |
3191 for (octave_idx_type i = 0; i < nr; i++) | |
1968 | 3192 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3193 Complex val = elem (i, j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3194 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3195 double r_val = std::real (val); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3196 double i_val = std::imag (val); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3197 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3198 if ((! (xisnan (r_val) || xisinf (r_val)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3199 && fabs (r_val) > FLT_MAX) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3200 || (! (xisnan (i_val) || xisinf (i_val)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3201 && fabs (i_val) > FLT_MAX)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3202 return true; |
1968 | 3203 } |
3204 | |
2384 | 3205 return false; |
1968 | 3206 } |
3207 | |
5775 | 3208 // FIXME Do these really belong here? Maybe they should be |
4015 | 3209 // in a base class? |
3210 | |
2832 | 3211 boolMatrix |
4015 | 3212 ComplexMatrix::all (int dim) const |
458 | 3213 { |
9227
8145f2255276
use explicit template qualifs to please Intel C++ and MSVC++
Jaroslav Hajek <highegg@gmail.com>
parents:
8999
diff
changeset
|
3214 return do_mx_red_op<boolMatrix, Complex> (*this, dim, mx_inline_all); |
458 | 3215 } |
3216 | |
2832 | 3217 boolMatrix |
4015 | 3218 ComplexMatrix::any (int dim) const |
458 | 3219 { |
9227
8145f2255276
use explicit template qualifs to please Intel C++ and MSVC++
Jaroslav Hajek <highegg@gmail.com>
parents:
8999
diff
changeset
|
3220 return do_mx_red_op<boolMatrix, Complex> (*this, dim, mx_inline_any); |
458 | 3221 } |
3222 | |
3223 ComplexMatrix | |
3723 | 3224 ComplexMatrix::cumprod (int dim) const |
458 | 3225 { |
9227
8145f2255276
use explicit template qualifs to please Intel C++ and MSVC++
Jaroslav Hajek <highegg@gmail.com>
parents:
8999
diff
changeset
|
3226 return do_mx_cum_op<ComplexMatrix, Complex> (*this, dim, mx_inline_cumprod); |
458 | 3227 } |
3228 | |
3229 ComplexMatrix | |
3723 | 3230 ComplexMatrix::cumsum (int dim) const |
458 | 3231 { |
9227
8145f2255276
use explicit template qualifs to please Intel C++ and MSVC++
Jaroslav Hajek <highegg@gmail.com>
parents:
8999
diff
changeset
|
3232 return do_mx_cum_op<ComplexMatrix, Complex> (*this, dim, mx_inline_cumsum); |
458 | 3233 } |
3234 | |
3235 ComplexMatrix | |
3723 | 3236 ComplexMatrix::prod (int dim) const |
458 | 3237 { |
9227
8145f2255276
use explicit template qualifs to please Intel C++ and MSVC++
Jaroslav Hajek <highegg@gmail.com>
parents:
8999
diff
changeset
|
3238 return do_mx_red_op<ComplexMatrix, Complex> (*this, dim, mx_inline_prod); |
458 | 3239 } |
3240 | |
3241 ComplexMatrix | |
3723 | 3242 ComplexMatrix::sum (int dim) const |
458 | 3243 { |
9227
8145f2255276
use explicit template qualifs to please Intel C++ and MSVC++
Jaroslav Hajek <highegg@gmail.com>
parents:
8999
diff
changeset
|
3244 return do_mx_red_op<ComplexMatrix, Complex> (*this, dim, mx_inline_sum); |
458 | 3245 } |
3246 | |
3247 ComplexMatrix | |
3723 | 3248 ComplexMatrix::sumsq (int dim) const |
458 | 3249 { |
9227
8145f2255276
use explicit template qualifs to please Intel C++ and MSVC++
Jaroslav Hajek <highegg@gmail.com>
parents:
8999
diff
changeset
|
3250 return do_mx_red_op<Matrix, Complex> (*this, dim, mx_inline_sumsq); |
458 | 3251 } |
3252 | |
4329 | 3253 Matrix ComplexMatrix::abs (void) const |
3254 { | |
8650
a1ae2aae903e
abs,real,imag,conj: use code from mx-inlines rather than the generic map
Jaroslav Hajek <highegg@gmail.com>
parents:
8614
diff
changeset
|
3255 return Matrix (mx_inline_cabs_dup (data (), length ()), |
a1ae2aae903e
abs,real,imag,conj: use code from mx-inlines rather than the generic map
Jaroslav Hajek <highegg@gmail.com>
parents:
8614
diff
changeset
|
3256 rows (), cols ()); |
4329 | 3257 } |
3258 | |
7620
36594d5bbe13
Move diag function into the octave_value class
David Bateman <dbateman@free.fr>
parents:
7544
diff
changeset
|
3259 ComplexMatrix |
5275 | 3260 ComplexMatrix::diag (octave_idx_type k) const |
458 | 3261 { |
7620
36594d5bbe13
Move diag function into the octave_value class
David Bateman <dbateman@free.fr>
parents:
7544
diff
changeset
|
3262 return MArray2<Complex>::diag (k); |
458 | 3263 } |
3264 | |
2354 | 3265 bool |
5275 | 3266 ComplexMatrix::row_is_real_only (octave_idx_type i) const |
2354 | 3267 { |
3268 bool retval = true; | |
3269 | |
5275 | 3270 octave_idx_type nc = columns (); |
3271 | |
3272 for (octave_idx_type j = 0; j < nc; j++) | |
2354 | 3273 { |
5315 | 3274 if (std::imag (elem (i, j)) != 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3275 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3276 retval = false; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3277 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3278 } |
2354 | 3279 } |
3280 | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3281 return retval; |
2354 | 3282 } |
3283 | |
3284 bool | |
5275 | 3285 ComplexMatrix::column_is_real_only (octave_idx_type j) const |
2354 | 3286 { |
3287 bool retval = true; | |
3288 | |
5275 | 3289 octave_idx_type nr = rows (); |
3290 | |
3291 for (octave_idx_type i = 0; i < nr; i++) | |
2354 | 3292 { |
5315 | 3293 if (std::imag (elem (i, j)) != 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3294 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3295 retval = false; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3296 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3297 } |
2354 | 3298 } |
3299 | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3300 return retval; |
2354 | 3301 } |
891 | 3302 |
458 | 3303 ComplexColumnVector |
3304 ComplexMatrix::row_min (void) const | |
3305 { | |
5275 | 3306 Array<octave_idx_type> dummy_idx; |
4587 | 3307 return row_min (dummy_idx); |
458 | 3308 } |
3309 | |
3310 ComplexColumnVector | |
5275 | 3311 ComplexMatrix::row_min (Array<octave_idx_type>& idx_arg) const |
458 | 3312 { |
3313 ComplexColumnVector result; | |
3314 | |
5275 | 3315 octave_idx_type nr = rows (); |
3316 octave_idx_type nc = cols (); | |
458 | 3317 |
3318 if (nr > 0 && nc > 0) | |
3319 { | |
3320 result.resize (nr); | |
4587 | 3321 idx_arg.resize (nr); |
458 | 3322 |
5275 | 3323 for (octave_idx_type i = 0; i < nr; i++) |
458 | 3324 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3325 bool real_only = row_is_real_only (i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3326 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3327 octave_idx_type idx_j; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3328 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3329 Complex tmp_min; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3330 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3331 double abs_min = octave_NaN; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3332 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3333 for (idx_j = 0; idx_j < nc; idx_j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3334 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3335 tmp_min = elem (i, idx_j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3336 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3337 if (! xisnan (tmp_min)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3338 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3339 abs_min = real_only ? std::real (tmp_min) : std::abs (tmp_min); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3340 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3341 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3342 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3343 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3344 for (octave_idx_type j = idx_j+1; j < nc; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3345 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3346 Complex tmp = elem (i, j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3347 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3348 if (xisnan (tmp)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3349 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3350 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3351 double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3352 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3353 if (abs_tmp < abs_min) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3354 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3355 idx_j = j; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3356 tmp_min = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3357 abs_min = abs_tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3358 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3359 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3360 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3361 if (xisnan (tmp_min)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3362 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3363 result.elem (i) = Complex_NaN_result; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3364 idx_arg.elem (i) = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3365 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3366 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3367 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3368 result.elem (i) = tmp_min; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3369 idx_arg.elem (i) = idx_j; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3370 } |
458 | 3371 } |
3372 } | |
3373 | |
3374 return result; | |
3375 } | |
3376 | |
3377 ComplexColumnVector | |
3378 ComplexMatrix::row_max (void) const | |
3379 { | |
5275 | 3380 Array<octave_idx_type> dummy_idx; |
4587 | 3381 return row_max (dummy_idx); |
458 | 3382 } |
3383 | |
3384 ComplexColumnVector | |
5275 | 3385 ComplexMatrix::row_max (Array<octave_idx_type>& idx_arg) const |
458 | 3386 { |
3387 ComplexColumnVector result; | |
3388 | |
5275 | 3389 octave_idx_type nr = rows (); |
3390 octave_idx_type nc = cols (); | |
458 | 3391 |
3392 if (nr > 0 && nc > 0) | |
3393 { | |
3394 result.resize (nr); | |
4587 | 3395 idx_arg.resize (nr); |
458 | 3396 |
5275 | 3397 for (octave_idx_type i = 0; i < nr; i++) |
458 | 3398 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3399 bool real_only = row_is_real_only (i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3400 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3401 octave_idx_type idx_j; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3402 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3403 Complex tmp_max; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3404 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3405 double abs_max = octave_NaN; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3406 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3407 for (idx_j = 0; idx_j < nc; idx_j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3408 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3409 tmp_max = elem (i, idx_j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3410 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3411 if (! xisnan (tmp_max)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3412 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3413 abs_max = real_only ? std::real (tmp_max) : std::abs (tmp_max); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3414 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3415 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3416 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3417 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3418 for (octave_idx_type j = idx_j+1; j < nc; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3419 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3420 Complex tmp = elem (i, j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3421 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3422 if (xisnan (tmp)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3423 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3424 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3425 double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3426 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3427 if (abs_tmp > abs_max) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3428 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3429 idx_j = j; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3430 tmp_max = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3431 abs_max = abs_tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3432 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3433 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3434 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3435 if (xisnan (tmp_max)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3436 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3437 result.elem (i) = Complex_NaN_result; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3438 idx_arg.elem (i) = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3439 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3440 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3441 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3442 result.elem (i) = tmp_max; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3443 idx_arg.elem (i) = idx_j; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3444 } |
458 | 3445 } |
3446 } | |
3447 | |
3448 return result; | |
3449 } | |
3450 | |
3451 ComplexRowVector | |
3452 ComplexMatrix::column_min (void) const | |
3453 { | |
5275 | 3454 Array<octave_idx_type> dummy_idx; |
4587 | 3455 return column_min (dummy_idx); |
458 | 3456 } |
3457 | |
3458 ComplexRowVector | |
5275 | 3459 ComplexMatrix::column_min (Array<octave_idx_type>& idx_arg) const |
458 | 3460 { |
3461 ComplexRowVector result; | |
3462 | |
5275 | 3463 octave_idx_type nr = rows (); |
3464 octave_idx_type nc = cols (); | |
458 | 3465 |
3466 if (nr > 0 && nc > 0) | |
3467 { | |
3468 result.resize (nc); | |
4587 | 3469 idx_arg.resize (nc); |
458 | 3470 |
5275 | 3471 for (octave_idx_type j = 0; j < nc; j++) |
458 | 3472 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3473 bool real_only = column_is_real_only (j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3474 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3475 octave_idx_type idx_i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3476 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3477 Complex tmp_min; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3478 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3479 double abs_min = octave_NaN; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3480 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3481 for (idx_i = 0; idx_i < nr; idx_i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3482 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3483 tmp_min = elem (idx_i, j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3484 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3485 if (! xisnan (tmp_min)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3486 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3487 abs_min = real_only ? std::real (tmp_min) : std::abs (tmp_min); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3488 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3489 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3490 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3491 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3492 for (octave_idx_type i = idx_i+1; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3493 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3494 Complex tmp = elem (i, j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3495 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3496 if (xisnan (tmp)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3497 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3498 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3499 double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3500 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3501 if (abs_tmp < abs_min) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3502 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3503 idx_i = i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3504 tmp_min = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3505 abs_min = abs_tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3506 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3507 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3508 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3509 if (xisnan (tmp_min)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3510 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3511 result.elem (j) = Complex_NaN_result; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3512 idx_arg.elem (j) = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3513 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3514 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3515 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3516 result.elem (j) = tmp_min; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3517 idx_arg.elem (j) = idx_i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3518 } |
458 | 3519 } |
3520 } | |
3521 | |
3522 return result; | |
3523 } | |
3524 | |
3525 ComplexRowVector | |
3526 ComplexMatrix::column_max (void) const | |
3527 { | |
5275 | 3528 Array<octave_idx_type> dummy_idx; |
4587 | 3529 return column_max (dummy_idx); |
458 | 3530 } |
3531 | |
3532 ComplexRowVector | |
5275 | 3533 ComplexMatrix::column_max (Array<octave_idx_type>& idx_arg) const |
458 | 3534 { |
3535 ComplexRowVector result; | |
3536 | |
5275 | 3537 octave_idx_type nr = rows (); |
3538 octave_idx_type nc = cols (); | |
458 | 3539 |
3540 if (nr > 0 && nc > 0) | |
3541 { | |
3542 result.resize (nc); | |
4587 | 3543 idx_arg.resize (nc); |
458 | 3544 |
5275 | 3545 for (octave_idx_type j = 0; j < nc; j++) |
458 | 3546 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3547 bool real_only = column_is_real_only (j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3548 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3549 octave_idx_type idx_i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3550 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3551 Complex tmp_max; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3552 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3553 double abs_max = octave_NaN; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3554 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3555 for (idx_i = 0; idx_i < nr; idx_i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3556 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3557 tmp_max = elem (idx_i, j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3558 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3559 if (! xisnan (tmp_max)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3560 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3561 abs_max = real_only ? std::real (tmp_max) : std::abs (tmp_max); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3562 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3563 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3564 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3565 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3566 for (octave_idx_type i = idx_i+1; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3567 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3568 Complex tmp = elem (i, j); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3569 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3570 if (xisnan (tmp)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3571 continue; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3572 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3573 double abs_tmp = real_only ? std::real (tmp) : std::abs (tmp); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3574 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3575 if (abs_tmp > abs_max) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3576 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3577 idx_i = i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3578 tmp_max = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3579 abs_max = abs_tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3580 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3581 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3582 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3583 if (xisnan (tmp_max)) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3584 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3585 result.elem (j) = Complex_NaN_result; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3586 idx_arg.elem (j) = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3587 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3588 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3589 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3590 result.elem (j) = tmp_max; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3591 idx_arg.elem (j) = idx_i; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3592 } |
458 | 3593 } |
3594 } | |
3595 | |
3596 return result; | |
3597 } | |
3598 | |
3599 // i/o | |
3600 | |
3504 | 3601 std::ostream& |
3602 operator << (std::ostream& os, const ComplexMatrix& a) | |
458 | 3603 { |
5275 | 3604 for (octave_idx_type i = 0; i < a.rows (); i++) |
458 | 3605 { |
5275 | 3606 for (octave_idx_type j = 0; j < a.cols (); j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3607 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3608 os << " "; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3609 octave_write_complex (os, a.elem (i, j)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3610 } |
458 | 3611 os << "\n"; |
3612 } | |
3613 return os; | |
3614 } | |
3615 | |
3504 | 3616 std::istream& |
3617 operator >> (std::istream& is, ComplexMatrix& a) | |
458 | 3618 { |
5275 | 3619 octave_idx_type nr = a.rows (); |
3620 octave_idx_type nc = a.cols (); | |
458 | 3621 |
8999
dc07bc4157b8
allow empty matrices in stream input operators
Jaroslav Hajek <highegg@gmail.com>
parents:
8956
diff
changeset
|
3622 if (nr > 0 && nc > 0) |
458 | 3623 { |
3624 Complex tmp; | |
5275 | 3625 for (octave_idx_type i = 0; i < nr; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3626 for (octave_idx_type j = 0; j < nc; j++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3627 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3628 tmp = octave_read_value<Complex> (is); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3629 if (is) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3630 a.elem (i, j) = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3631 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3632 goto done; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3633 } |
458 | 3634 } |
3635 | |
2993 | 3636 done: |
3637 | |
458 | 3638 return is; |
3639 } | |
3640 | |
1819 | 3641 ComplexMatrix |
3642 Givens (const Complex& x, const Complex& y) | |
3643 { | |
3644 double cc; | |
3645 Complex cs, temp_r; | |
3646 | |
3887 | 3647 F77_FUNC (zlartg, ZLARTG) (x, y, cc, cs, temp_r); |
1819 | 3648 |
3649 ComplexMatrix g (2, 2); | |
3650 | |
3651 g.elem (0, 0) = cc; | |
3652 g.elem (1, 1) = cc; | |
3653 g.elem (0, 1) = cs; | |
3654 g.elem (1, 0) = -conj (cs); | |
3655 | |
3656 return g; | |
3657 } | |
3658 | |
3659 ComplexMatrix | |
3660 Sylvester (const ComplexMatrix& a, const ComplexMatrix& b, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3661 const ComplexMatrix& c) |
1819 | 3662 { |
3663 ComplexMatrix retval; | |
3664 | |
5775 | 3665 // FIXME -- need to check that a, b, and c are all the same |
1819 | 3666 // size. |
3667 | |
3668 // Compute Schur decompositions | |
3669 | |
3670 ComplexSCHUR as (a, "U"); | |
3671 ComplexSCHUR bs (b, "U"); | |
3672 | |
3673 // Transform c to new coordinates. | |
3674 | |
3675 ComplexMatrix ua = as.unitary_matrix (); | |
3676 ComplexMatrix sch_a = as.schur_matrix (); | |
3677 | |
3678 ComplexMatrix ub = bs.unitary_matrix (); | |
3679 ComplexMatrix sch_b = bs.schur_matrix (); | |
3680 | |
3681 ComplexMatrix cx = ua.hermitian () * c * ub; | |
3682 | |
3683 // Solve the sylvester equation, back-transform, and return the | |
3684 // solution. | |
3685 | |
5275 | 3686 octave_idx_type a_nr = a.rows (); |
3687 octave_idx_type b_nr = b.rows (); | |
1819 | 3688 |
3689 double scale; | |
5275 | 3690 octave_idx_type info; |
1950 | 3691 |
3692 Complex *pa = sch_a.fortran_vec (); | |
3693 Complex *pb = sch_b.fortran_vec (); | |
3694 Complex *px = cx.fortran_vec (); | |
1819 | 3695 |
4552 | 3696 F77_XFCN (ztrsyl, ZTRSYL, (F77_CONST_CHAR_ARG2 ("N", 1), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3697 F77_CONST_CHAR_ARG2 ("N", 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3698 1, a_nr, b_nr, pa, a_nr, pb, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3699 b_nr, px, a_nr, scale, info |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3700 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3701 F77_CHAR_ARG_LEN (1))); |
1950 | 3702 |
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
3703 // FIXME -- check info? |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
3704 |
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7478
diff
changeset
|
3705 retval = -ua * cx * ub.hermitian (); |
1819 | 3706 |
3707 return retval; | |
3708 } | |
3709 | |
2828 | 3710 ComplexMatrix |
3711 operator * (const ComplexMatrix& m, const Matrix& a) | |
3712 { | |
9663
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
3713 if (m.columns () > std::min (m.rows (), a.columns ()) / 10) |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
3714 return ComplexMatrix (real (m) * a, imag (m) * a); |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
3715 else |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
3716 return m * ComplexMatrix (a); |
2828 | 3717 } |
3718 | |
3719 ComplexMatrix | |
3720 operator * (const Matrix& m, const ComplexMatrix& a) | |
3721 { | |
9663
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
3722 if (a.rows () > std::min (m.rows (), a.columns ()) / 10) |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
3723 return ComplexMatrix (m * real (a), m * imag (a)); |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
3724 else |
7e5b4de5fbfe
improve mixed real x complex ops
Jaroslav Hajek <highegg@gmail.com>
parents:
9661
diff
changeset
|
3725 return m * ComplexMatrix (a); |
2828 | 3726 } |
3727 | |
6162 | 3728 /* Simple Dot Product, Matrix-Vector and Matrix-Matrix Unit tests |
3729 %!assert([1+i 2+i 3+i] * [ 4+i ; 5+i ; 6+i], 29+21i, 1e-14) | |
3730 %!assert([1+i 2+i ; 3+i 4+i ] * [5+i ; 6+i], [15 + 14i ; 37 + 18i], 1e-14) | |
3731 %!assert([1+i 2+i ; 3+i 4+i ] * [5+i 6+i ; 7+i 8+i], [17 + 15i 20 + 17i; 41 + 19i 48 + 21i], 1e-14) | |
9526
f3ebc728ffd7
fix typos in complex xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9523
diff
changeset
|
3732 %!assert([1 i]*[i 0]', -i); |
6162 | 3733 */ |
3734 | |
3735 /* Test some simple identities | |
3736 %!shared M, cv, rv | |
3737 %! M = randn(10,10)+i*rand(10,10); | |
3738 %! cv = randn(10,1)+i*rand(10,1); | |
3739 %! rv = randn(1,10)+i*rand(1,10); | |
3740 %!assert([M*cv,M*cv],M*[cv,cv],1e-14) | |
9528
ec066ba012c8
more fixes & tests for matrix multiply
Jaroslav Hajek <highegg@gmail.com>
parents:
9526
diff
changeset
|
3741 %!assert([M.'*cv,M.'*cv],M.'*[cv,cv],1e-14) |
ec066ba012c8
more fixes & tests for matrix multiply
Jaroslav Hajek <highegg@gmail.com>
parents:
9526
diff
changeset
|
3742 %!assert([M'*cv,M'*cv],M'*[cv,cv],1e-14) |
6162 | 3743 %!assert([rv*M;rv*M],[rv;rv]*M,1e-14) |
9528
ec066ba012c8
more fixes & tests for matrix multiply
Jaroslav Hajek <highegg@gmail.com>
parents:
9526
diff
changeset
|
3744 %!assert([rv*M.';rv*M.'],[rv;rv]*M.',1e-14) |
ec066ba012c8
more fixes & tests for matrix multiply
Jaroslav Hajek <highegg@gmail.com>
parents:
9526
diff
changeset
|
3745 %!assert([rv*M';rv*M'],[rv;rv]*M',1e-14) |
6162 | 3746 %!assert(2*rv*cv,[rv,rv]*[cv;cv],1e-14) |
3747 */ | |
3748 | |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3749 static const char * |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3750 get_blas_trans_arg (bool trans, bool conj) |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3751 { |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3752 static char blas_notrans = 'N', blas_trans = 'T', blas_conj_trans = 'C'; |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3753 return trans ? (conj ? &blas_conj_trans : &blas_trans) : &blas_notrans; |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3754 } |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3755 |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3756 // the general GEMM operation |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3757 |
2828 | 3758 ComplexMatrix |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3759 xgemm (const ComplexMatrix& a, const ComplexMatrix& b, |
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3760 blas_trans_type transa, blas_trans_type transb) |
2828 | 3761 { |
3762 ComplexMatrix retval; | |
3763 | |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3764 bool tra = transa != blas_no_trans, trb = transb != blas_no_trans; |
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3765 bool cja = transa == blas_conj_trans, cjb = transb == blas_conj_trans; |
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3766 |
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3767 octave_idx_type a_nr = tra ? a.cols () : a.rows (); |
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3768 octave_idx_type a_nc = tra ? a.rows () : a.cols (); |
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3769 |
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3770 octave_idx_type b_nr = trb ? b.cols () : b.rows (); |
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3771 octave_idx_type b_nc = trb ? b.rows () : b.cols (); |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3772 |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3773 if (a_nc != b_nr) |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3774 gripe_nonconformant ("operator *", a_nr, a_nc, b_nr, b_nc); |
2828 | 3775 else |
3776 { | |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3777 if (a_nr == 0 || a_nc == 0 || b_nc == 0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3778 retval = ComplexMatrix (a_nr, b_nc, 0.0); |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3779 else if (a.data () == b.data () && a_nr == b_nc && tra != trb) |
7801
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3780 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3781 octave_idx_type lda = a.rows (); |
7801
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3782 |
9359
be6867ba8104
avoid useless zero initialization when doing matrix multiply
Jaroslav Hajek <highegg@gmail.com>
parents:
9227
diff
changeset
|
3783 retval = ComplexMatrix (a_nr, b_nc); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3784 Complex *c = retval.fortran_vec (); |
7801
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3785 |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3786 const char *ctra = get_blas_trans_arg (tra, cja); |
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3787 if (cja || cjb) |
7801
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3788 { |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3789 F77_XFCN (zherk, ZHERK, (F77_CONST_CHAR_ARG2 ("U", 1), |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3790 F77_CONST_CHAR_ARG2 (ctra, 1), |
7801
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3791 a_nr, a_nc, 1.0, |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3792 a.data (), lda, 0.0, c, a_nr |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3793 F77_CHAR_ARG_LEN (1) |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3794 F77_CHAR_ARG_LEN (1))); |
10124
e5c6600e3400
use octave_idx_type where needed
Jaroslav Hajek <highegg@gmail.com>
parents:
10105
diff
changeset
|
3795 for (octave_idx_type j = 0; j < a_nr; j++) |
e5c6600e3400
use octave_idx_type where needed
Jaroslav Hajek <highegg@gmail.com>
parents:
10105
diff
changeset
|
3796 for (octave_idx_type i = 0; i < j; i++) |
7801
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3797 retval.xelem (j,i) = std::conj (retval.xelem (i,j)); |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3798 } |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3799 else |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3800 { |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3801 F77_XFCN (zsyrk, ZSYRK, (F77_CONST_CHAR_ARG2 ("U", 1), |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3802 F77_CONST_CHAR_ARG2 (ctra, 1), |
7801
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3803 a_nr, a_nc, 1.0, |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3804 a.data (), lda, 0.0, c, a_nr |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3805 F77_CHAR_ARG_LEN (1) |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3806 F77_CHAR_ARG_LEN (1))); |
10124
e5c6600e3400
use octave_idx_type where needed
Jaroslav Hajek <highegg@gmail.com>
parents:
10105
diff
changeset
|
3807 for (octave_idx_type j = 0; j < a_nr; j++) |
e5c6600e3400
use octave_idx_type where needed
Jaroslav Hajek <highegg@gmail.com>
parents:
10105
diff
changeset
|
3808 for (octave_idx_type i = 0; i < j; i++) |
7801
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3809 retval.xelem (j,i) = retval.xelem (i,j); |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3810 |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3811 } |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3812 |
776791438957
map symmetric cases to xHERK, xSYRK
Jaroslav Hajek <highegg@gmail.com>
parents:
7800
diff
changeset
|
3813 } |
2828 | 3814 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3815 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3816 octave_idx_type lda = a.rows (), tda = a.cols (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3817 octave_idx_type ldb = b.rows (), tdb = b.cols (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3818 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3819 retval = ComplexMatrix (a_nr, b_nc); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3820 Complex *c = retval.fortran_vec (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3821 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3822 if (b_nc == 1 && a_nr == 1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3823 { |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3824 if (cja == cjb) |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3825 { |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3826 F77_FUNC (xzdotu, XZDOTU) (a_nc, a.data (), 1, b.data (), 1, *c); |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3827 if (cja) *c = std::conj (*c); |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3828 } |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3829 else if (cja) |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3830 F77_FUNC (xzdotc, XZDOTC) (a_nc, a.data (), 1, b.data (), 1, *c); |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3831 else |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3832 F77_FUNC (xzdotc, XZDOTC) (a_nc, b.data (), 1, a.data (), 1, *c); |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3833 } |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3834 else if (b_nc == 1 && ! cjb) |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3835 { |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3836 const char *ctra = get_blas_trans_arg (tra, cja); |
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3837 F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 (ctra, 1), |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3838 lda, tda, 1.0, a.data (), lda, |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3839 b.data (), 1, 0.0, c, 1 |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3840 F77_CHAR_ARG_LEN (1))); |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3841 } |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3842 else if (a_nr == 1 && ! cja && ! cjb) |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3843 { |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3844 const char *crevtrb = get_blas_trans_arg (! trb, cjb); |
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3845 F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 (crevtrb, 1), |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3846 ldb, tdb, 1.0, b.data (), ldb, |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3847 a.data (), 1, 0.0, c, 1 |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3848 F77_CHAR_ARG_LEN (1))); |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3849 } |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3850 else |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3851 { |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3852 const char *ctra = get_blas_trans_arg (tra, cja); |
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3853 const char *ctrb = get_blas_trans_arg (trb, cjb); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3854 F77_XFCN (zgemm, ZGEMM, (F77_CONST_CHAR_ARG2 (ctra, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3855 F77_CONST_CHAR_ARG2 (ctrb, 1), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3856 a_nr, b_nc, a_nc, 1.0, a.data (), |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3857 lda, b.data (), ldb, 0.0, c, a_nr |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3858 F77_CHAR_ARG_LEN (1) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3859 F77_CHAR_ARG_LEN (1))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3860 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3861 } |
2828 | 3862 } |
3863 | |
3864 return retval; | |
3865 } | |
3866 | |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3867 ComplexMatrix |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3868 operator * (const ComplexMatrix& a, const ComplexMatrix& b) |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3869 { |
9665
1dba57e9d08d
use blas_trans_type for xgemm
Jaroslav Hajek <highegg@gmail.com>
parents:
9663
diff
changeset
|
3870 return xgemm (a, b); |
7800
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3871 } |
5861b95e9879
support for compound operators, implement trans_mul, mul_trans, herm_mul and mul_herm
Jaroslav Hajek <highegg@gmail.com>
parents:
7789
diff
changeset
|
3872 |
5775 | 3873 // FIXME -- it would be nice to share code among the min/max |
4309 | 3874 // functions below. |
3875 | |
3876 #define EMPTY_RETURN_CHECK(T) \ | |
3877 if (nr == 0 || nc == 0) \ | |
3878 return T (nr, nc); | |
3879 | |
3880 ComplexMatrix | |
3881 min (const Complex& c, const ComplexMatrix& m) | |
3882 { | |
5275 | 3883 octave_idx_type nr = m.rows (); |
3884 octave_idx_type nc = m.columns (); | |
4309 | 3885 |
3886 EMPTY_RETURN_CHECK (ComplexMatrix); | |
3887 | |
3888 ComplexMatrix result (nr, nc); | |
3889 | |
5275 | 3890 for (octave_idx_type j = 0; j < nc; j++) |
3891 for (octave_idx_type i = 0; i < nr; i++) | |
4309 | 3892 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3893 octave_quit (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3894 result (i, j) = xmin (c, m (i, j)); |
4309 | 3895 } |
3896 | |
3897 return result; | |
3898 } | |
3899 | |
3900 ComplexMatrix | |
3901 min (const ComplexMatrix& m, const Complex& c) | |
3902 { | |
5275 | 3903 octave_idx_type nr = m.rows (); |
3904 octave_idx_type nc = m.columns (); | |
4309 | 3905 |
3906 EMPTY_RETURN_CHECK (ComplexMatrix); | |
3907 | |
3908 ComplexMatrix result (nr, nc); | |
3909 | |
5275 | 3910 for (octave_idx_type j = 0; j < nc; j++) |
3911 for (octave_idx_type i = 0; i < nr; i++) | |
4309 | 3912 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3913 octave_quit (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3914 result (i, j) = xmin (m (i, j), c); |
4309 | 3915 } |
3916 | |
3917 return result; | |
3918 } | |
3919 | |
3920 ComplexMatrix | |
3921 min (const ComplexMatrix& a, const ComplexMatrix& b) | |
3922 { | |
5275 | 3923 octave_idx_type nr = a.rows (); |
3924 octave_idx_type nc = a.columns (); | |
4309 | 3925 |
3926 if (nr != b.rows () || nc != b.columns ()) | |
3927 { | |
3928 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3929 ("two-arg min expecting args of same size"); |
4309 | 3930 return ComplexMatrix (); |
3931 } | |
3932 | |
3933 EMPTY_RETURN_CHECK (ComplexMatrix); | |
3934 | |
3935 ComplexMatrix result (nr, nc); | |
3936 | |
5275 | 3937 for (octave_idx_type j = 0; j < nc; j++) |
4309 | 3938 { |
3939 int columns_are_real_only = 1; | |
5275 | 3940 for (octave_idx_type i = 0; i < nr; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3941 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3942 octave_quit (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3943 if (std::imag (a (i, j)) != 0.0 || std::imag (b (i, j)) != 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3944 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3945 columns_are_real_only = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3946 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3947 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3948 } |
4309 | 3949 |
3950 if (columns_are_real_only) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3951 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3952 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3953 result (i, j) = xmin (std::real (a (i, j)), std::real (b (i, j))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3954 } |
4309 | 3955 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3956 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3957 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3958 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3959 octave_quit (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3960 result (i, j) = xmin (a (i, j), b (i, j)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3961 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3962 } |
4309 | 3963 } |
3964 | |
3965 return result; | |
3966 } | |
3967 | |
3968 ComplexMatrix | |
3969 max (const Complex& c, const ComplexMatrix& m) | |
3970 { | |
5275 | 3971 octave_idx_type nr = m.rows (); |
3972 octave_idx_type nc = m.columns (); | |
4309 | 3973 |
3974 EMPTY_RETURN_CHECK (ComplexMatrix); | |
3975 | |
3976 ComplexMatrix result (nr, nc); | |
3977 | |
5275 | 3978 for (octave_idx_type j = 0; j < nc; j++) |
3979 for (octave_idx_type i = 0; i < nr; i++) | |
4309 | 3980 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3981 octave_quit (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
3982 result (i, j) = xmax (c, m (i, j)); |
4309 | 3983 } |
3984 | |
3985 return result; | |
3986 } | |
3987 | |
3988 ComplexMatrix | |
3989 max (const ComplexMatrix& m, const Complex& c) | |
3990 { | |
5275 | 3991 octave_idx_type nr = m.rows (); |
3992 octave_idx_type nc = m.columns (); | |
4309 | 3993 |
3994 EMPTY_RETURN_CHECK (ComplexMatrix); | |
3995 | |
3996 ComplexMatrix result (nr, nc); | |
3997 | |
5275 | 3998 for (octave_idx_type j = 0; j < nc; j++) |
3999 for (octave_idx_type i = 0; i < nr; i++) | |
4309 | 4000 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4001 octave_quit (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4002 result (i, j) = xmax (m (i, j), c); |
4309 | 4003 } |
4004 | |
4005 return result; | |
4006 } | |
4007 | |
4008 ComplexMatrix | |
4009 max (const ComplexMatrix& a, const ComplexMatrix& b) | |
4010 { | |
5275 | 4011 octave_idx_type nr = a.rows (); |
4012 octave_idx_type nc = a.columns (); | |
4309 | 4013 |
4014 if (nr != b.rows () || nc != b.columns ()) | |
4015 { | |
4016 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4017 ("two-arg max expecting args of same size"); |
4309 | 4018 return ComplexMatrix (); |
4019 } | |
4020 | |
4021 EMPTY_RETURN_CHECK (ComplexMatrix); | |
4022 | |
4023 ComplexMatrix result (nr, nc); | |
4024 | |
5275 | 4025 for (octave_idx_type j = 0; j < nc; j++) |
4309 | 4026 { |
4027 int columns_are_real_only = 1; | |
5275 | 4028 for (octave_idx_type i = 0; i < nr; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4029 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4030 octave_quit (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4031 if (std::imag (a (i, j)) != 0.0 || std::imag (b (i, j)) != 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4032 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4033 columns_are_real_only = 0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4034 break; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4035 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4036 } |
4309 | 4037 |
4038 if (columns_are_real_only) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4039 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4040 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4041 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4042 octave_quit (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4043 result (i, j) = xmax (std::real (a (i, j)), std::real (b (i, j))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4044 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4045 } |
4309 | 4046 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4047 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4048 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4049 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4050 octave_quit (); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4051 result (i, j) = xmax (a (i, j), b (i, j)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4052 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10213
diff
changeset
|
4053 } |
4309 | 4054 } |
4055 | |
4056 return result; | |
4057 } | |
4058 | |
9653
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4059 ComplexMatrix linspace (const ComplexColumnVector& x1, |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4060 const ComplexColumnVector& x2, |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4061 octave_idx_type n) |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4062 |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4063 { |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4064 if (n < 1) n = 1; |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4065 |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4066 octave_idx_type m = x1.length (); |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4067 |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4068 if (x2.length () != m) |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4069 (*current_liboctave_error_handler) ("linspace: vectors must be of equal length"); |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4070 |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4071 NoAlias<ComplexMatrix> retval; |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4072 |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4073 retval.clear (m, n); |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4074 for (octave_idx_type i = 0; i < m; i++) |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4075 retval(i, 0) = x1(i); |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4076 |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4077 // The last column is not needed while using delta. |
9658
3429c956de6f
extend linspace & fix up liboctave rewrite
Jaroslav Hajek <highegg@gmail.com>
parents:
9653
diff
changeset
|
4078 Complex *delta = &retval(0, n-1); |
9653
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4079 for (octave_idx_type i = 0; i < m; i++) |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4080 delta[i] = (x2(i) - x1(i)) / (n - 1.0); |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4081 |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4082 for (octave_idx_type j = 1; j < n-1; j++) |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4083 for (octave_idx_type i = 0; i < m; i++) |
9658
3429c956de6f
extend linspace & fix up liboctave rewrite
Jaroslav Hajek <highegg@gmail.com>
parents:
9653
diff
changeset
|
4084 retval(i, j) = x1(i) + static_cast<double> (j)*delta[i]; |
9653
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4085 |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4086 for (octave_idx_type i = 0; i < m; i++) |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4087 retval(i, n-1) = x2(i); |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4088 |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4089 return retval; |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4090 } |
e087d7c77ff9
improve linspace in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9601
diff
changeset
|
4091 |
9578
7dafdb8b062f
refactor comparison ops implementations
Jaroslav Hajek <highegg@gmail.com>
parents:
9553
diff
changeset
|
4092 MS_CMP_OPS (ComplexMatrix, Complex) |
9550
3d6a9aea2aea
refactor binary & bool ops in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9528
diff
changeset
|
4093 MS_BOOL_OPS (ComplexMatrix, Complex) |
2870 | 4094 |
9578
7dafdb8b062f
refactor comparison ops implementations
Jaroslav Hajek <highegg@gmail.com>
parents:
9553
diff
changeset
|
4095 SM_CMP_OPS (Complex, ComplexMatrix) |
9550
3d6a9aea2aea
refactor binary & bool ops in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9528
diff
changeset
|
4096 SM_BOOL_OPS (Complex, ComplexMatrix) |
2870 | 4097 |
9578
7dafdb8b062f
refactor comparison ops implementations
Jaroslav Hajek <highegg@gmail.com>
parents:
9553
diff
changeset
|
4098 MM_CMP_OPS (ComplexMatrix, ComplexMatrix) |
9550
3d6a9aea2aea
refactor binary & bool ops in liboctave
Jaroslav Hajek <highegg@gmail.com>
parents:
9528
diff
changeset
|
4099 MM_BOOL_OPS (ComplexMatrix, ComplexMatrix) |