Merge remote-tracking branch 'origin/master' into windows
[scilab.git] / scilab / modules / linear_algebra / src / cpp / scischur.cpp
1 /*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) 2011 - DIGITEO - Cedric DELAMARRE
4 *
5  * Copyright (C) 2012 - 2016 - Scilab Enterprises
6  *
7  * This file is hereby licensed under the terms of the GNU GPL v2.0,
8  * pursuant to article 5.3.4 of the CeCILL v.2.1.
9  * This file was originally licensed under the terms of the CeCILL v2.1,
10  * and continues to be available under such terms.
11  * For more information, see the COPYING file which you should have received
12  * along with this program.
13 *
14 */
15 /*--------------------------------------------------------------------------*/
16 #include "configvariable.hxx"
17 #include "callable.hxx"
18 #include "double.hxx"
19 #include "bool.hxx"
20 #include "function.hxx"
21 #include "commentexp.hxx"
22
23 extern "C"
24 {
25 #include "scischur.h"
26 #include "elem_common.h"
27 }
28
29 int schur_sb02mw(double* _real, double* _img)
30 {
31     return dpythags(*_real, *_img) < 1 ? 1 : 0;
32 }
33 int schur_sb02mv(double* _real, double* /*_img*/)
34 {
35     /* original Fortran code does not use _img aka IEIG (SB02MV = REIG.LT.ZERO) */
36     return *_real < 0 ? 1 : 0;
37 }
38 int schur_dgees(double* _real, double* _img)
39 {
40     types::Callable* pCall = ConfigVariable::getSchurFunction();
41     if (pCall == NULL)
42     {
43         return 0;
44     }
45
46     char errorMsg[256];
47     int iRet = 0;
48
49     types::typed_list in;
50     types::typed_list out;
51     types::optional_list opt;
52     int iRetCount = 1;
53
54     types::Double* pDbl = new types::Double(*_real, *_img);
55     pDbl->IncreaseRef();
56     in.push_back(pDbl);
57
58     try
59     {
60         // new std::wstring(L"") is delete in destructor of ast::CommentExp
61         pCall->invoke(in, opt, iRetCount, out, ast::CommentExp(Location(), new std::string("")));
62     }
63     catch (const ast::InternalAbort& ia)
64     {
65         pDbl->DecreaseRef();
66         pDbl->killMe();
67         throw ia;
68     }
69     catch (const ast::InternalError& ie)
70     {
71         pDbl->DecreaseRef();
72         pDbl->killMe();
73         throw ie;
74     }
75
76     pDbl->DecreaseRef();
77     pDbl->killMe();
78
79     if (out.size() != 1)
80     {
81         const char* pstrName = pCall->getName().c_str();
82         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
83         throw ast::InternalError(errorMsg);
84     }
85
86     if (out[0]->isDouble())
87     {
88         types::Double* pDblOut = out[0]->getAs<types::Double>();
89         iRet = pDblOut->get(0) == 0 ? 0 : 1;
90         pDblOut->killMe();
91     }
92     else if (out[0]->isBool())
93     {
94         types::Bool* pBoolOut = out[0]->getAs<types::Bool>();
95         iRet = pBoolOut->get(0) == 0 ? 0 : 1;
96         pBoolOut->killMe();
97     }
98
99     return iRet;
100 }
101
102 int schur_sb02ox(double* _real, double* _img, double* _beta) // discrete
103 {
104     return dpythags(*_real, *_img) < fabs(*_beta) ? 1 : 0;
105 }
106 int schur_sb02ow(double* _real, double* /*_img*/, double* _beta) // continu
107 {
108     return  (*_real < 0 && *_beta > 0) ||
109             ((*_real > 0 && *_beta < 0) &&
110              (fabs(*_beta) > fabs(*_real) * nc_eps_machine())) ? 1 : 0;
111 }
112 int schur_dgges(double* _real, double* _img, double* _beta)
113 {
114     types::Callable* pCall = ConfigVariable::getSchurFunction();
115     if (pCall == NULL)
116     {
117         return 0;
118     }
119
120     char errorMsg[256];
121     int iRet = 0;
122
123     types::typed_list in;
124     types::typed_list out;
125     types::optional_list opt;
126     int iRetCount = 1;
127
128     types::Double* pDblAlpha = new types::Double(*_real, *_img);
129     pDblAlpha->IncreaseRef();
130     types::Double* pDblBeta  = new types::Double(*_beta);
131     pDblBeta->IncreaseRef();
132     in.push_back(pDblAlpha);
133     in.push_back(pDblBeta);
134
135     try
136     {
137         // new std::wstring(L"") is delete in destructor of ast::CommentExp
138         pCall->invoke(in, opt, iRetCount, out, ast::CommentExp(Location(), new std::string("")));
139     }
140     catch (const ast::InternalAbort& ia)
141     {
142         pDblAlpha->DecreaseRef();
143         pDblAlpha->killMe();
144         pDblBeta->DecreaseRef();
145         pDblBeta->killMe();
146         throw ia;
147     }
148     catch (const ast::InternalError& ie)
149     {
150         pDblAlpha->DecreaseRef();
151         pDblAlpha->killMe();
152         pDblBeta->DecreaseRef();
153         pDblBeta->killMe();
154         throw ie;
155     }
156
157     pDblAlpha->DecreaseRef();
158     pDblAlpha->killMe();
159     pDblBeta->DecreaseRef();
160     pDblBeta->killMe();
161
162     if (out.size() != 1)
163     {
164         const char* pstrName = pCall->getName().c_str();
165         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
166         throw ast::InternalError(errorMsg);
167     }
168
169     if (out[0]->isDouble())
170     {
171         types::Double* pDblOut = out[0]->getAs<types::Double>();
172         iRet = pDblOut->get(0) == 0 ? 0 : 1;
173         pDblOut->killMe();
174     }
175     else if (out[0]->isBool())
176     {
177         types::Bool* pBoolOut = out[0]->getAs<types::Bool>();
178         iRet = pBoolOut->get(0) == 0 ? 0 : 1;
179         pBoolOut->killMe();
180     }
181
182     return iRet;
183 }
184
185 int schur_zb02mw(doublecomplex* _complex)
186 {
187     return dpythags(_complex->r, _complex->i) < 1 ? 1 : 0;
188 }
189 int schur_zb02mv(doublecomplex* _complex)
190 {
191     return _complex->r < 0 ? 1 : 0;
192 }
193 int schur_zgees(doublecomplex* _complex)
194 {
195     types::Callable* pCall = ConfigVariable::getSchurFunction();
196     if (pCall == NULL)
197     {
198         return 0;
199     }
200
201     char errorMsg[256];
202     int iRet = 0;
203
204     types::typed_list in;
205     types::typed_list out;
206     types::optional_list opt;
207     int iRetCount = 1;
208
209     types::Double* pDbl = new types::Double(_complex->r, _complex->i);
210     pDbl->IncreaseRef();
211     in.push_back(pDbl);
212
213     try
214     {
215         // new std::wstring(L"") is delete in destructor of ast::CommentExp
216         pCall->invoke(in, opt, iRetCount, out, ast::CommentExp(Location(), new std::string("")));
217     }
218     catch (const ast::InternalAbort& ia)
219     {
220         pDbl->DecreaseRef();
221         pDbl->killMe();
222         throw ia;
223     }
224     catch (const ast::InternalError& ie)
225     {
226         pDbl->DecreaseRef();
227         pDbl->killMe();
228         throw ie;
229     }
230
231     pDbl->DecreaseRef();
232     pDbl->killMe();
233
234     if (out.size() != 1)
235     {
236         const char* pstrName = pCall->getName().c_str();
237         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
238         throw ast::InternalError(errorMsg);
239     }
240
241     if (out[0]->isDouble())
242     {
243         types::Double* pDblOut = out[0]->getAs<types::Double>();
244         iRet = pDblOut->get(0) == 0 ? 0 : 1;
245         pDblOut->killMe();
246     }
247     else if (out[0]->isBool())
248     {
249         types::Bool* pBoolOut = out[0]->getAs<types::Bool>();
250         iRet = pBoolOut->get(0) == 0 ? 0 : 1;
251         pBoolOut->killMe();
252     }
253
254     return iRet;
255 }
256
257 int schur_zb02ox(doublecomplex* _alpha, doublecomplex* _beta) // discrete
258 {
259     return dpythags(_alpha->r, _alpha->i) < dpythags(_beta->r, _beta->i) ? 1 : 0;
260 }
261 int schur_zb02ow(doublecomplex* _alpha, doublecomplex* _beta) // continu
262 {
263     double absolute = dpythags(_beta->r, _beta->i);
264     int res = 0;
265
266     if (absolute)
267     {
268         res = ((_alpha->r * _beta->r + _alpha->i * _beta->i) / (_beta->r * _beta->r + _beta->i + _beta->i)) < 0 ? 1 : 0;
269     }
270
271     return res;
272 }
273 int schur_zgges(doublecomplex* _alpha, doublecomplex* _beta)
274 {
275     types::Callable* pCall = ConfigVariable::getSchurFunction();
276     if (pCall == NULL)
277     {
278         return 0;
279     }
280
281     char errorMsg[256];
282     int iRet = 0;
283
284     types::typed_list in;
285     types::typed_list out;
286     types::optional_list opt;
287     int iRetCount = 1;
288
289     types::Double* pDblAlpha = new types::Double(_alpha->r, _alpha->i);
290     pDblAlpha->IncreaseRef();
291     types::Double* pDblBeta  = new types::Double(_beta->r, _beta->i);
292     pDblBeta->IncreaseRef();
293     in.push_back(pDblAlpha);
294     in.push_back(pDblBeta);
295
296     try
297     {
298         // new std::wstring(L"") is delete in destructor of ast::CommentExp
299         pCall->invoke(in, opt, iRetCount, out, ast::CommentExp(Location(), new std::string("")));
300     }
301     catch (const ast::InternalAbort& ia)
302     {
303         pDblAlpha->DecreaseRef();
304         pDblAlpha->killMe();
305         pDblBeta->DecreaseRef();
306         pDblBeta->killMe();
307         throw ia;
308     }
309     catch (const ast::InternalError& ie)
310     {
311         pDblAlpha->DecreaseRef();
312         pDblAlpha->killMe();
313         pDblBeta->DecreaseRef();
314         pDblBeta->killMe();
315         throw ie;
316     }
317
318     pDblAlpha->DecreaseRef();
319     pDblAlpha->killMe();
320     pDblBeta->DecreaseRef();
321     pDblBeta->killMe();
322
323     if (out.size() != 1)
324     {
325         const char* pstrName = pCall->getName().c_str();
326         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
327         throw ast::InternalError(errorMsg);
328     }
329
330     if (out[0]->isDouble())
331     {
332         types::Double* pDblOut = out[0]->getAs<types::Double>();
333         iRet = pDblOut->get(0) == 0 ? 0 : 1;
334         pDblOut->killMe();
335     }
336     else if (out[0]->isBool())
337     {
338         types::Bool* pBoolOut = out[0]->getAs<types::Bool>();
339         iRet = pBoolOut->get(0) == 0 ? 0 : 1;
340         pBoolOut->killMe();
341     }
342
343     return iRet;
344 }
345