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