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