linear_algebra plugged.
[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 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution.  The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12 /*--------------------------------------------------------------------------*/
13 #include "configvariable.hxx"
14 #include "callable.hxx"
15 #include "execvisitor.hxx"
16 #include "double.hxx"
17 #include "bool.hxx"
18
19 extern "C"
20 {
21     #include "scischur.h"
22     #include "elem_common.h"
23 }
24
25 int schur_sb02mw(double* _real, double* _img)
26 {
27     return dpythags(*_real, *_img) < 1 ? 1 : 0;
28 }
29 int schur_sb02mv(double* _real, double* _img)
30 {/* original Fortran code does not use _img aka IEIG (SB02MV = REIG.LT.ZERO) */
31     return *_real < 0 ? 1 : 0;
32 }
33 int schur_dgees(double* _real, double* _img)
34 {
35     types::Callable* pCall = ConfigVariable::getSchurFunction();
36     int iRet = 0;
37
38     if(pCall)
39     {
40         typed_list in;
41         typed_list out;
42         int iRetCount = 1;
43         ast::ExecVisitor execFunc;
44
45         types::Double* pDbl = new types::Double(*_real, *_img);
46         pDbl->IncreaseRef();
47         in.push_back(pDbl);
48
49         bool bOk = pCall->call(in, iRetCount, out, &execFunc) == types::Function::OK;
50         pDbl->DecreaseRef();
51         delete pDbl;
52         pDbl = NULL;
53
54         if(bOk == false)
55         {
56             return 0;
57         }
58
59         if(out.size() != 1)
60         {
61             return 0;
62         }
63
64         if(out[0]->isDouble())
65         {
66             types::Double* pDblOut = out[0]->getAs<types::Double>();
67             iRet = pDblOut->get(0) == 0 ? 0 : 1;
68             delete pDblOut;
69             pDblOut = NULL;
70
71             return iRet;
72         }
73         else if(out[0]->isBool())
74         {
75             types::Bool* pBoolOut = out[0]->getAs<types::Bool>();
76             iRet = pBoolOut->get(0) == 0 ? 0 : 1;
77             delete pBoolOut;
78             pBoolOut = NULL;
79
80             return iRet;
81         }
82     }
83     return 0;
84 }
85
86 int schur_sb02ox(double* _real, double* _img, double* _beta) // discrete
87 {
88     return dpythags(*_real, *_img) < fabs(*_beta) ? 1 : 0;
89 }
90 int schur_sb02ow(double* _real, double* _img, double* _beta) // continu
91 {
92     return  (*_real < 0 && *_beta > 0) || 
93             (*_real > 0 && *_beta < 0) && 
94             (fabs(*_beta) > fabs(*_real) * C2F(dlamch)((char*)"p", 1L)) ? 1 : 0;
95 }
96 int schur_dgges(double* _real, double* _img, double* _beta)
97 {
98     types::Callable* pCall = ConfigVariable::getSchurFunction();
99     int iRet = 0;
100
101     if(pCall)
102     {
103         typed_list in;
104         typed_list out;
105         int iRetCount = 1;
106         ast::ExecVisitor execFunc;
107
108         types::Double* pDblAlpha = new types::Double(*_real, *_img);
109         pDblAlpha->IncreaseRef();
110         types::Double* pDblBeta  = new types::Double(*_beta);
111         pDblBeta->IncreaseRef();
112         in.push_back(pDblAlpha);
113         in.push_back(pDblBeta);
114
115         bool bOk = pCall->call(in, iRetCount, out, &execFunc) == types::Function::OK;
116         pDblAlpha->DecreaseRef();
117         delete pDblAlpha;
118         pDblAlpha = NULL;
119         pDblBeta->DecreaseRef();
120         delete pDblBeta;
121         pDblBeta = NULL;
122
123         if(bOk == false)
124         {
125             return 0;
126         }
127
128         if(out.size() != 1)
129         {
130             return 0;
131         }
132         
133         if(out[0]->isDouble())
134         {
135             types::Double* pDblOut = out[0]->getAs<types::Double>();
136             iRet = pDblOut->get(0) == 0 ? 0 : 1;
137             delete pDblOut;
138             pDblOut = NULL;
139
140             return iRet;
141         }
142         else if(out[0]->isBool())
143         {
144             types::Bool* pBoolOut = out[0]->getAs<types::Bool>();
145             iRet = pBoolOut->get(0) == 0 ? 0 : 1;
146             delete pBoolOut;
147             pBoolOut = NULL;
148
149             return iRet;
150         }
151     }
152
153     return 0;
154 }
155
156 int schur_zb02mw(doublecomplex* _complex)
157 {
158     return dpythags(_complex->r, _complex->i) < 1 ? 1 : 0;
159 }
160 int schur_zb02mv(doublecomplex* _complex)
161 {
162     return _complex->r < 0 ? 1 : 0;
163 }
164 int schur_zgees(doublecomplex* _complex)
165 {
166     types::Callable* pCall = ConfigVariable::getSchurFunction();
167     int iRet = 0;
168
169     if(pCall)
170     {
171         typed_list in;
172         typed_list out;
173         int iRetCount = 1;
174         ast::ExecVisitor execFunc;
175
176         types::Double* pDbl = new types::Double(_complex->r, _complex->i);
177         pDbl->IncreaseRef();
178         in.push_back(pDbl);
179
180         bool bOk = pCall->call(in, iRetCount, out, &execFunc) == types::Function::OK;
181         pDbl->DecreaseRef();
182         delete pDbl;
183         pDbl = NULL;
184
185         if(bOk == false)
186         {
187             return 0;
188         }
189
190         if(out.size() != 1)
191         {
192             return 0;
193         }
194         
195         if(out[0]->isDouble())
196         {
197             types::Double* pDblOut = out[0]->getAs<types::Double>();
198             iRet = pDblOut->get(0) == 0 ? 0 : 1;
199             delete pDblOut;
200             pDblOut = NULL;
201
202             return iRet;
203         }
204         else if(out[0]->isBool())
205         {
206             types::Bool* pBoolOut = out[0]->getAs<types::Bool>();
207             iRet = pBoolOut->get(0) == 0 ? 0 : 1;
208             delete pBoolOut;
209             pBoolOut = NULL;
210
211             return iRet;
212         }
213     }
214     return 0;
215 }
216
217 int schur_zb02ox(doublecomplex* _alpha, doublecomplex* _beta) // discrete
218 {
219     return dpythags(_alpha->r, _alpha->i) < dpythags(_beta->r, _beta->i) ? 1 : 0;
220 }
221 int schur_zb02ow(doublecomplex* _alpha, doublecomplex* _beta) // continu
222 {
223     double absolute = dpythags(_beta->r, _beta->i);
224     int res = 0;
225
226     if(absolute)
227     {
228         res = ((_alpha->r * _beta->r + _alpha->i * _beta->i) / (_beta->r * _beta->r + _beta->i + _beta->i)) < 0 ? 1 : 0;
229     }
230
231     return res;
232 }
233 int schur_zgges(doublecomplex* _alpha, doublecomplex* _beta)
234 {
235     types::Callable* pCall = ConfigVariable::getSchurFunction();
236     int iRet = 0;
237
238     if(pCall)
239     {
240         typed_list in;
241         typed_list out;
242         int iRetCount = 1;
243         ast::ExecVisitor execFunc;
244
245         types::Double* pDblAlpha = new types::Double(_alpha->r, _alpha->i);
246         pDblAlpha->IncreaseRef();
247         types::Double* pDblBeta  = new types::Double(_beta->r, _beta->i);
248         pDblBeta->IncreaseRef();
249         in.push_back(pDblAlpha);
250         in.push_back(pDblBeta);
251
252         bool bOk = pCall->call(in, iRetCount, out, &execFunc) == types::Function::OK;
253         pDblAlpha->DecreaseRef();
254         delete pDblAlpha;
255         pDblAlpha = NULL;
256         pDblBeta->DecreaseRef();
257         delete pDblBeta;
258         pDblBeta = NULL;
259
260         if(bOk == false)
261         {
262             return 0;
263         }
264
265         if(out.size() != 1)
266         {
267             return 0;
268         }
269         
270         if(out[0]->isDouble())
271         {
272             types::Double* pDblOut = out[0]->getAs<types::Double>();
273             iRet = pDblOut->get(0) == 0 ? 0 : 1;
274             delete pDblOut;
275             pDblOut = NULL;
276
277             return iRet;
278         }
279         else if(out[0]->isBool())
280         {
281             types::Bool* pBoolOut = out[0]->getAs<types::Bool>();
282             iRet = pBoolOut->get(0) == 0 ? 0 : 1;
283             delete pBoolOut;
284             pBoolOut = NULL;
285
286             return iRet;
287         }
288     }
289     return 0;
290 }
291