Management of errors in differential equations functions.
[scilab.git] / scilab / modules / differential_equations / sci_gateway / cpp / sci_feval.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 "sciprint.h"
28 #include "scifunctions.h"
29 #include "feval.h"
30 }
31
32 /*--------------------------------------------------------------------------*/
33 types::Function::ReturnValue sci_feval(types::typed_list &in, int _iRetCount, types::typed_list &out)
34 {
35     int iPos = 0;
36     int nn   = 1;
37
38     //input
39     types::Double* pDblX = NULL;
40     types::Double* pDblY = NULL;
41
42     // output
43     types::Double* pDblOut = NULL;
44
45     // *** check the minimal number of input args. ***
46     if (in.size() < 2 || in.size() > 3)
47     {
48         Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "feval", 2, 3);
49         return types::Function::Error;
50     }
51
52     // *** check number of output args according the methode. ***
53     if (_iRetCount > 1)
54     {
55         Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "feval", 1);
56         return types::Function::Error;
57     }
58
59     // *** check type of input args and get it. ***
60     // X
61     if (in[iPos]->isDouble() == false)
62     {
63         Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
64         return types::Function::Error;
65     }
66     pDblX = in[iPos]->getAs<types::Double>();
67     if (pDblX->isComplex())
68     {
69         Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
70         return types::Function::Error;
71     }
72     iPos++;
73
74     // Y
75     if (in.size() == 3)
76     {
77         if (in[iPos]->isDouble() == false)
78         {
79             Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
80             return types::Function::Error;
81         }
82         pDblY = in[iPos]->getAs<types::Double>();
83         if (pDblY->isComplex())
84         {
85             Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
86             return types::Function::Error;
87         }
88         iPos++;
89         nn = 2;
90     }
91
92     // function
93     DifferentialEquationFunctions* deFunctionsManager = new DifferentialEquationFunctions(L"feval");
94     DifferentialEquation::addDifferentialEquationFunctions(deFunctionsManager);
95
96     if (in[iPos]->isCallable())
97     {
98         types::Callable* pCall = in[iPos]->getAs<types::Callable>();
99         deFunctionsManager->setFFunction(pCall);
100     }
101     else if (in[iPos]->isString())
102     {
103         bool bOK = false;
104         types::String* pStr = in[iPos]->getAs<types::String>();
105         bOK = deFunctionsManager->setFFunction(pStr);
106
107         if (bOK == false)
108         {
109             char* pst = wide_string_to_UTF8(pStr->get(0));
110             Scierror(50, _("%s: Subroutine not found: %s\n"), "feval", pst);
111             FREE(pst);
112             DifferentialEquation::removeDifferentialEquationFunctions();
113             return types::Function::Error;
114         }
115     }
116     else if (in[iPos]->isList())
117     {
118         types::List* pList = in[iPos]->getAs<types::List>();
119
120         if (pList->getSize() == 0)
121         {
122             Scierror(50, _("%s: Argument #%d : Subroutine not found in list: %s\n"), "feval", iPos + 1, "(string empty)");
123             DifferentialEquation::removeDifferentialEquationFunctions();
124             return types::Function::Error;
125         }
126
127         if (pList->get(0)->isCallable())
128         {
129             deFunctionsManager->setFFunction(pList->get(0)->getAs<types::Callable>());
130             for (int iter = 1; iter < pList->getSize(); iter++)
131             {
132                 deFunctionsManager->setFArgs(pList->get(iter)->getAs<types::InternalType>());
133             }
134         }
135         else
136         {
137             Scierror(999, _("%s: Wrong type for input argument #%d : The first argument in the list must be a Scilab function.\n"), "feval", 4);
138             DifferentialEquation::removeDifferentialEquationFunctions();
139             return types::Function::Error;
140         }
141     }
142     else
143     {
144         Scierror(999, _("%s: Wrong type for input argument #%d : A function expected.\n"), "feval", iPos + 1);
145         DifferentialEquation::removeDifferentialEquationFunctions();
146         return types::Function::Error;
147     }
148
149     // *** Perform operation. ***
150     int itype       = 0; // output value
151     double* res     = (double*)MALLOC(2 * sizeof(double));
152     int sizeOfY     = pDblY ? pDblY->getSize() : 1;
153
154     if (nn == 2)
155     {
156         pDblOut = new types::Double(pDblX->getSize(), sizeOfY);
157     }
158     else
159     {
160         pDblOut = new types::Double(pDblX->getRows(), pDblX->getCols());
161     }
162
163     for (int y = 0; y < sizeOfY; y++)
164     {
165         for (int x = 0; x < pDblX->getSize(); x++)
166         {
167             double valX = pDblX->get(x);
168             // if pDblY == NULL, nn == 1 so valY will be never used.
169             double valY = pDblY ? pDblY->get(y) : 0;
170
171             try
172             {
173                 deFunctionsManager->execFevalF(&nn, &valX, &valY, res, &itype);
174             }
175             catch (ScilabError &e)
176             {
177                 char* pstrMsg = wide_string_to_UTF8(e.GetErrorMessage().c_str());
178                 sciprint(_("%s: exception caught in '%s' subroutine.\n"), "feval", "execFevalF");
179                 Scierror(999, pstrMsg);
180                 DifferentialEquation::removeDifferentialEquationFunctions();
181                 FREE(res);
182                 delete pDblOut;
183                 return types::Function::Error;
184             }
185
186             if (itype) // is complex
187             {
188                 pDblOut->setComplex(true);
189                 pDblOut->set(x + y * pDblX->getSize(), res[0]);
190                 pDblOut->setImg(x + y * pDblX->getSize(), res[1]);
191             }
192             else
193             {
194                 pDblOut->set(x + y * pDblX->getSize(), res[0]);
195             }
196         }
197     }
198
199     // *** Return result in Scilab. ***
200
201     out.push_back(pDblOut);
202
203     FREE(res);
204     DifferentialEquation::removeDifferentialEquationFunctions();
205
206     return types::Function::OK;
207 }
208 /*--------------------------------------------------------------------------*/
209