Mercurial > octave-nkf

comparison liboctave/CmplxHESS.cc @ 7482:29980c6b8604

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
don't check f77_exception_encountered
author John W. Eaton <jwe@octave.org>
date Thu, 14 Feb 2008 21:57:50 -0500
parents a1dbe9d80eee
children eb63fbe60fab
comparison
equal deleted inserted replaced
7481:78f3811155f7 7482:29980c6b8604
86 86
87 F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), 87 F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1),
88 n, h, n, ilo, ihi, pscale, info 88 n, h, n, ilo, ihi, pscale, info
89 F77_CHAR_ARG_LEN (1))); 89 F77_CHAR_ARG_LEN (1)));
90 90
91 if (f77_exception_encountered) 91 Array<Complex> tau (n-1);
92 (*current_liboctave_error_handler) ("unrecoverable error in zgebal"); 92 Complex *ptau = tau.fortran_vec ();
93 else
94 {
95 Array<Complex> tau (n-1);
96 Complex *ptau = tau.fortran_vec ();
97 93
98 Array<Complex> work (lwork); 94 Array<Complex> work (lwork);
99 Complex *pwork = work.fortran_vec (); 95 Complex *pwork = work.fortran_vec ();
100 96
101 F77_XFCN (zgehrd, ZGEHRD, (n, ilo, ihi, h, n, ptau, pwork, lwork, info)); 97 F77_XFCN (zgehrd, ZGEHRD, (n, ilo, ihi, h, n, ptau, pwork, lwork, info));
102 98
103 if (f77_exception_encountered) 99 unitary_hess_mat = hess_mat;
104 (*current_liboctave_error_handler) ("unrecoverable error in zgehrd"); 100 Complex *z = unitary_hess_mat.fortran_vec ();
105 else
106 {
107 unitary_hess_mat = hess_mat;
108 Complex *z = unitary_hess_mat.fortran_vec ();
109 101
110 F77_XFCN (zunghr, ZUNGHR, (n, ilo, ihi, z, n, ptau, pwork, 102 F77_XFCN (zunghr, ZUNGHR, (n, ilo, ihi, z, n, ptau, pwork,
111 lwork, info)); 103 lwork, info));
112 104
113 if (f77_exception_encountered) 105 F77_XFCN (zgebak, ZGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1),
114 (*current_liboctave_error_handler) 106 F77_CONST_CHAR_ARG2 (&side, 1),
115 ("unrecoverable error in zunghr"); 107 n, ilo, ihi, pscale, n, z, n, info
116 else 108 F77_CHAR_ARG_LEN (1)
117 { 109 F77_CHAR_ARG_LEN (1)));
118 F77_XFCN (zgebak, ZGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1),
119 F77_CONST_CHAR_ARG2 (&side, 1),
120 n, ilo, ihi, pscale, n, z, n, info
121 F77_CHAR_ARG_LEN (1)
122 F77_CHAR_ARG_LEN (1)));
123 110
124 if (f77_exception_encountered) 111 // If someone thinks of a more graceful way of
125 (*current_liboctave_error_handler) 112 // doing this (or faster for that matter :-)),
126 ("unrecoverable error in zgebak"); 113 // please let me know!
127 else
128 {
129 // If someone thinks of a more graceful way of
130 // doing this (or faster for that matter :-)),
131 // please let me know!
132 114
133 if (n > 2) 115 if (n > 2)
134 for (octave_idx_type j = 0; j < a_nc; j++) 116 for (octave_idx_type j = 0; j < a_nc; j++)
135 for (octave_idx_type i = j+2; i < a_nr; i++) 117 for (octave_idx_type i = j+2; i < a_nr; i++)
136 hess_mat.elem (i, j) = 0; 118 hess_mat.elem (i, j) = 0;
137 }
138 }
139 }
140 }
141 119
142 return info; 120 return info;
143 } 121 }
144 122
145 /* 123 /*