Mercurial > hg > octave-lyh
annotate liboctave/numeric/CmplxHESS.cc @ 16626:4adf3c4bd80b
GUI compilation fixes for MSVC.
* libgui/src/dialog.cc (ACTIVE_ESCAPE, RICH_TEXT): Define to 1 instead of
"true".
(LINE_EDIT_FOLLOWS_PROMPT): Define to 0 instead of "false".
*libgui/src/settings-dialog.cc (settings_dialog::read_lexer_settings,
settings_dialog::read_workspace_colors,
settings_dialog::read_terminal_colors): Use QVector instead of C99
non-constant arrays.
| author | Michael Goffioul <michael.goffioul@gmail.com> |
|---|---|
| date | Mon, 06 May 2013 20:02:08 -0400 |
| parents | 648dabbb4c6b |
| children |
| rev | line source |
|---|---|
| 457 | 1 /* |
| 2 | |
|
14138
72c96de7a403
maint: update copyright notices for 2012
John W. Eaton <jwe@octave.org>
parents:
11586
diff
changeset
|
3 Copyright (C) 1994-2012 John W. Eaton |
| 457 | 4 |
| 5 This file is part of Octave. | |
| 6 | |
| 7 Octave is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 7016 | 9 Free Software Foundation; either version 3 of the License, or (at your |
| 10 option) any later version. | |
| 457 | 11 |
| 12 Octave is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 7016 | 18 along with Octave; see the file COPYING. If not, see |
| 19 <http://www.gnu.org/licenses/>. | |
| 457 | 20 |
| 21 */ | |
| 22 | |
| 23 #ifdef HAVE_CONFIG_H | |
| 1192 | 24 #include <config.h> |
| 457 | 25 #endif |
| 26 | |
| 27 #include "CmplxHESS.h" | |
| 1847 | 28 #include "f77-fcn.h" |
| 457 | 29 #include "lo-error.h" |
| 30 | |
| 31 extern "C" | |
| 32 { | |
| 4552 | 33 F77_RET_T |
| 34 F77_FUNC (zgebal, ZGEBAL) (F77_CONST_CHAR_ARG_DECL, | |
| 11495 | 35 const octave_idx_type&, Complex*, |
| 36 const octave_idx_type&, octave_idx_type&, | |
| 37 octave_idx_type&, double*, octave_idx_type& | |
|
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
38 F77_CHAR_ARG_LEN_DECL); |
|
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
39 |
| 4552 | 40 F77_RET_T |
| 11495 | 41 F77_FUNC (zgehrd, ZGEHRD) (const octave_idx_type&, const octave_idx_type&, |
| 42 const octave_idx_type&, Complex*, | |
| 43 const octave_idx_type&, Complex*, Complex*, | |
| 44 const octave_idx_type&, octave_idx_type&); | |
|
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11570
diff
changeset
|
45 |
| 4552 | 46 F77_RET_T |
| 11495 | 47 F77_FUNC (zunghr, ZUNGHR) (const octave_idx_type&, const octave_idx_type&, |
| 48 const octave_idx_type&, Complex*, | |
| 49 const octave_idx_type&, Complex*, Complex*, | |
| 50 const octave_idx_type&, octave_idx_type&); | |
| 457 | 51 |
| 4552 | 52 F77_RET_T |
| 53 F77_FUNC (zgebak, ZGEBAK) (F77_CONST_CHAR_ARG_DECL, | |
|
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
54 F77_CONST_CHAR_ARG_DECL, |
| 11495 | 55 const octave_idx_type&, const octave_idx_type&, |
| 56 const octave_idx_type&, double*, | |
| 57 const octave_idx_type&, Complex*, | |
| 58 const octave_idx_type&, octave_idx_type& | |
|
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
59 F77_CHAR_ARG_LEN_DECL |
|
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
60 F77_CHAR_ARG_LEN_DECL); |
| 457 | 61 } |
| 62 | |
| 5275 | 63 octave_idx_type |
| 457 | 64 ComplexHESS::init (const ComplexMatrix& a) |
| 65 { | |
| 5275 | 66 octave_idx_type a_nr = a.rows (); |
| 67 octave_idx_type a_nc = a.cols (); | |
| 1932 | 68 |
| 69 if (a_nr != a_nc) | |
| 70 { | |
| 71 (*current_liboctave_error_handler) | |
|
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
72 ("ComplexHESS requires square matrix"); |
| 1932 | 73 return -1; |
| 74 } | |
| 457 | 75 |
| 1932 | 76 char job = 'N'; |
| 77 char side = 'R'; | |
| 78 | |
| 5275 | 79 octave_idx_type n = a_nc; |
| 80 octave_idx_type lwork = 32 * n; | |
| 81 octave_idx_type info; | |
| 82 octave_idx_type ilo; | |
| 83 octave_idx_type ihi; | |
| 457 | 84 |
| 1932 | 85 hess_mat = a; |
| 86 Complex *h = hess_mat.fortran_vec (); | |
| 457 | 87 |
|
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
88 Array<double> scale (dim_vector (n, 1)); |
| 1932 | 89 double *pscale = scale.fortran_vec (); |
| 90 | |
| 4552 | 91 F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), |
|
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
92 n, h, n, ilo, ihi, pscale, info |
|
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
93 F77_CHAR_ARG_LEN (1))); |
| 457 | 94 |
|
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
95 Array<Complex> tau (dim_vector (n-1, 1)); |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
96 Complex *ptau = tau.fortran_vec (); |
| 457 | 97 |
|
11570
57632dea2446
attempt better backward compatibility for Array constructors
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
98 Array<Complex> work (dim_vector (lwork, 1)); |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
99 Complex *pwork = work.fortran_vec (); |
| 457 | 100 |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
101 F77_XFCN (zgehrd, ZGEHRD, (n, ilo, ihi, h, n, ptau, pwork, lwork, info)); |
| 457 | 102 |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
103 unitary_hess_mat = hess_mat; |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
104 Complex *z = unitary_hess_mat.fortran_vec (); |
| 457 | 105 |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
106 F77_XFCN (zunghr, ZUNGHR, (n, ilo, ihi, z, n, ptau, pwork, |
|
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
107 lwork, info)); |
| 457 | 108 |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
109 F77_XFCN (zgebak, ZGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), |
|
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
110 F77_CONST_CHAR_ARG2 (&side, 1), |
|
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
111 n, ilo, ihi, pscale, n, z, n, info |
|
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
112 F77_CHAR_ARG_LEN (1) |
|
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
113 F77_CHAR_ARG_LEN (1))); |
| 457 | 114 |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
115 // If someone thinks of a more graceful way of |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
116 // doing this (or faster for that matter :-)), |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
117 // please let me know! |
| 457 | 118 |
|
7482
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
119 if (n > 2) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
120 for (octave_idx_type j = 0; j < a_nc; j++) |
|
29980c6b8604
don't check f77_exception_encountered
John W. Eaton <jwe@octave.org>
parents:
7017
diff
changeset
|
121 for (octave_idx_type i = j+2; i < a_nr; i++) |
|
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10158
diff
changeset
|
122 hess_mat.elem (i, j) = 0; |
| 457 | 123 |
| 1932 | 124 return info; |
| 457 | 125 } |