c476eed9536ac59329337c2b71d9d3eb213b3798
[scilab.git] / scilab / modules / differential_equations / sci_gateway / cpp / sci_int2d.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
14 #include "differential_equations_gw.hxx"
15 #include "function.hxx"
16 #include "double.hxx"
17 #include "string.hxx"
18 #include "list.hxx"
19 #include "callable.hxx"
20 #include "differentialequationfunctions.hxx"
21
22 extern "C"
23 {
24 #include "sci_malloc.h"
25 #include "localization.h"
26 #include "Scierror.h"
27 #include "scifunctions.h"
28 #include "configvariable_interface.h"
29 #include "sciprint.h"
30 }
31
32 /*--------------------------------------------------------------------------*/
33 types::Function::ReturnValue sci_int2d(types::typed_list &in, int _iRetCount, types::typed_list &out)
34 {
35     //input
36     types::Double* pDblX        = NULL;
37     types::Double* pDblY        = NULL;
38     types::Double* pDblParams   = NULL;
39
40     double tol   = 1.0e-10;
41     int iclose   = 1;
42     int maxtri   = 50;
43     int mevals   = 4000;
44     int iflag    = 1;
45
46     // output
47     double result   = 0;
48     double err      = 0;
49     int nevals      = 0;
50     int nu          = 0;
51     int nd          = 0;
52
53     // error message catched
54     std::ostringstream os;
55     bool bCatch = false;
56
57     // *** check the minimal number of input args. ***
58     if (in.size() < 3 || in.size() > 4)
59     {
60         Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "int2d", 3, 4);
61         return types::Function::Error;
62     }
63
64     // *** check number of output args according the methode. ***
65     if (_iRetCount > 3)
66     {
67         Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "int2d", 2);
68         return types::Function::Error;
69     }
70
71     // *** check type of input args and get it. ***
72     // X
73     if (in[0]->isDouble() == false)
74     {
75         Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "int2d", 1);
76         return types::Function::Error;
77     }
78     pDblX = in[0]->getAs<types::Double>();//->clone()->getAs<types::Double>();
79     if (pDblX->isComplex())
80     {
81         Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "int2d", 1);
82         return types::Function::Error;
83     }
84
85     if (pDblX->getRows() != 3)
86     {
87         Scierror(999, _("%s: Wrong size for input argument #%d: A 3 by N matrix expected.\n"), "int2d", 1);
88         return types::Function::Error;
89     }
90
91     // Y
92     if (in[1]->isDouble() == false)
93     {
94         Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "int2d", 2);
95         return types::Function::Error;
96     }
97     pDblY = in[1]->getAs<types::Double>();//->clone()->getAs<types::Double>();
98     if (pDblY->isComplex())
99     {
100         Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "int2d", 2);
101         return types::Function::Error;
102     }
103
104     if (pDblY->getRows() != 3)
105     {
106         Scierror(999, _("%s: Wrong size for input argument #%d: A 3 by N matrix expected.\n"), "int2d", 2);
107         return types::Function::Error;
108     }
109
110     if (pDblY->getCols() != pDblX->getCols())
111     {
112         Scierror(999, _("%s: Wrong size for input argument #%d: Same size of input argument %d expected.\n"), "int2d", 2, 1);
113         return types::Function::Error;
114     }
115
116
117     // function
118     DifferentialEquationFunctions deFunctionsManager("int2d");
119     DifferentialEquation::addDifferentialEquationFunctions(&deFunctionsManager);
120
121     if (in[2]->isCallable())
122     {
123         types::Callable* pCall = in[2]->getAs<types::Callable>();
124         deFunctionsManager.setFFunction(pCall);
125
126         // check function
127         double x = 1;
128         double y = 1;
129         double ret = int2d_f(&x, &y);
130         if (ret == 0)
131         {
132             Scierror(50, _("%s: Argument #%d: Variable returned by scilab argument function is incorrect.\n"), "int2d", 3);
133             DifferentialEquation::removeDifferentialEquationFunctions();
134             return types::Function::Error;
135         }
136     }
137     else if (in[2]->isString())
138     {
139         bool bOK = false;
140         types::String* pStr = in[2]->getAs<types::String>();
141         bOK = deFunctionsManager.setFFunction(pStr);
142
143         if (bOK == false)
144         {
145             const char* pst = pStr->get(0);
146             Scierror(50, _("%s: Subroutine not found: %s\n"), "int2d", pst);
147             DifferentialEquation::removeDifferentialEquationFunctions();
148             return types::Function::Error;
149         }
150     }
151     else if (in[2]->isList())
152     {
153         types::List* pList = in[2]->getAs<types::List>();
154
155         if (pList->getSize() == 0)
156         {
157             Scierror(50, _("%s: Argument #%d: Subroutine not found in list: %s\n"), "int2d", 3, "(string empty)");
158             DifferentialEquation::removeDifferentialEquationFunctions();
159             return types::Function::Error;
160         }
161
162         if (pList->get(0)->isCallable())
163         {
164             deFunctionsManager.setFFunction(pList->get(0)->getAs<types::Callable>());
165             for (int iter = 1; iter < pList->getSize(); iter++)
166             {
167                 deFunctionsManager.setFArgs(pList->get(iter)->getAs<types::InternalType>());
168             }
169         }
170         else
171         {
172             Scierror(999, _("%s: Wrong type for input argument #%d: The first argument in the list must be a Scilab function.\n"), "int2d", 3);
173             DifferentialEquation::removeDifferentialEquationFunctions();
174             return types::Function::Error;
175         }
176     }
177     else
178     {
179         Scierror(999, _("%s: Wrong type for input argument #%d: A function expected.\n"), "int2d", 3);
180         DifferentialEquation::removeDifferentialEquationFunctions();
181         return types::Function::Error;
182     }
183
184     // params (optional)
185     if (in.size() == 4)
186     {
187         if (in[3]->isDouble() == false)
188         {
189             Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "int2d", 4);
190             DifferentialEquation::removeDifferentialEquationFunctions();
191             return types::Function::Error;
192         }
193
194         pDblParams = in[3]->getAs<types::Double>();
195         if (pDblParams->isComplex())
196         {
197             Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "int2d", 4);
198             DifferentialEquation::removeDifferentialEquationFunctions();
199             return types::Function::Error;
200         }
201
202         if (pDblParams->getSize() != 5)
203         {
204             Scierror(999, _("%s: Wrong size for input argument #%d: %d expected.\n"), "int2d", 4, 5);
205             DifferentialEquation::removeDifferentialEquationFunctions();
206             return types::Function::Error;
207         }
208
209         if (getWarningMode())
210         {
211             if (pDblParams->get(0) < 0.0e0)
212             {
213                 sciprint(_("%ls: Warning: Wrong value for the first element of argument #%d: The default value will be used.\n"), L"int2d", 4);
214             }
215
216             if (pDblParams->get(2) < 1)
217             {
218                 sciprint(_("%ls: Warning: Wrong value for the third element of argument #%d: The default value will be used.\n"), L"int2d", 4);
219             }
220
221             if (pDblParams->get(3) < 1)
222             {
223                 sciprint(_("%ls: Warning: Wrong value for the fourth element of argument #%d: The default value will be used.\n"), L"int2d", 4);
224             }
225         }
226
227         tol      = pDblParams->get(0) < 0.0e0 ? tol : pDblParams->get(0);
228         iclose   = (int)pDblParams->get(1);
229         maxtri   = pDblParams->get(2) < 1 ? maxtri : (int)pDblParams->get(2);
230         mevals   = pDblParams->get(3) < 1 ? mevals : (int)pDblParams->get(3);
231         iflag    = (int)pDblParams->get(4);
232     }
233
234     // *** Perform operation. ***
235     int size = pDblX->getCols();
236
237     double* dwork   = (double*)MALLOC(9 * maxtri * sizeof(double));
238     int* iwork      = (int*)MALLOC(2 * maxtri * sizeof(int));
239
240     try
241     {
242         C2F(twodq)(int2d_f, &size, pDblX->get(), pDblY->get(), &tol, &iclose, &maxtri, &mevals, &result, &err, &nu, &nd, &nevals, &iflag, dwork, iwork);
243     }
244     catch (ast::InternalError &ie)
245     {
246         os << ie.GetErrorMessage();
247         bCatch = false;
248     }
249
250     FREE(dwork);
251     FREE(iwork);
252     DifferentialEquation::removeDifferentialEquationFunctions();
253
254     if (bCatch)
255     {
256         char szError[bsiz];
257         os_sprintf(szError, _("%s: An error occured in '%s' subroutine.\n"), "int2d", "twodq");
258         os << szError;
259         throw ast::InternalError(os.str());
260     }
261
262     if (iflag)
263     {
264         switch (iflag)
265         {
266             case 1 :
267             {
268                 Scierror(999, _("%s: Means termination for lack of space to divide another triangle.\n"), "int2d");
269                 break;
270             }
271             case 2 :
272             {
273                 Scierror(999, _("%s: Means termination because of roundoff noise.\n"), "int2d");
274                 break;
275             }
276             case 3 :
277             {
278                 Scierror(999, _("%s: means termination with relative error <= 5.0* machine epsilon.\n"), "int2d");
279                 break;
280             }
281             case 4 :
282             {
283                 Scierror(999, _("%s: Means termination because the number of function evaluations has exceeded MEVALS.\n"), "int2d");
284                 break;
285             }
286             case 9 :
287             {
288                 Scierror(999, _("%s: Means termination because of error in input flag.\n"), "int2d");
289                 break;
290             }
291             default :// normaly nerver call.
292             {
293                 Scierror(999, _("%s: twodq return with state %d.\n"), "int2d", iflag);
294             }
295         }
296         return types::Function::Error;
297     }
298
299     // *** Return result in Scilab. ***
300     types::Double* pDblOut = new types::Double(result);
301     out.push_back(pDblOut);
302
303     if (_iRetCount > 1)
304     {
305         types::Double* pDblErrOut = new types::Double(err);
306         out.push_back(pDblErrOut);
307     }
308
309     if (_iRetCount == 3)
310     {
311         types::Double* pDblNevalsOut = new types::Double((double)nevals);
312         out.push_back(pDblNevalsOut);
313     }
314
315     return types::Function::OK;
316 }
317 /*--------------------------------------------------------------------------*/
318