6bb9b0f96b6ea695388b1211778bc433c2e766e6
[scilab.git] / scilab / modules / differential_equations / src / cpp / differentialequationfunctions.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 "execvisitor.hxx"
14 #include "string.hxx"
15 #include "double.hxx"
16 #include "differentialequationfunctions.hxx"
17
18 extern "C"
19 {
20 #include "elem_common.h"
21 #include "scifunctions.h"
22 #include "Ex-odedc.h"
23 #include "Ex-ode.h"
24 #include "Ex-daskr.h"
25 #include "localization.h"
26 }
27
28 /*
29 ** differential equation functions
30 ** \{
31 */
32
33 // need the current thread, not the last running thread.
34
35 std::map<__threadId, DifferentialEquationFunctions*> DifferentialEquation::m_mapDifferentialEquationFunctions;
36
37 void DifferentialEquation::addDifferentialEquationFunctions(DifferentialEquationFunctions* _deFunction)
38 {
39     types::ThreadId* pThread = ConfigVariable::getLastRunningThread();
40     m_mapDifferentialEquationFunctions[pThread->getThreadId()] = _deFunction;
41 }
42
43 void DifferentialEquation::removeDifferentialEquationFunctions()
44 {
45     types::ThreadId* pThread = ConfigVariable::getLastRunningThread();
46     m_mapDifferentialEquationFunctions.erase(pThread->getThreadId());
47 }
48
49 DifferentialEquationFunctions* DifferentialEquation::getDifferentialEquationFunctions()
50 {
51     types::ThreadId* pThread = ConfigVariable::getLastRunningThread();
52     return m_mapDifferentialEquationFunctions[pThread->getThreadId()];
53 }
54
55
56 /*
57 ** \}
58 */
59
60
61
62 /*--------------------------------------------------------------------------*/
63 DifferentialEquationFunctions::DifferentialEquationFunctions(const std::wstring& callerName)
64 {
65     m_odeYRows      = 0;
66     m_odeYCols      = 0;
67     m_odedcYDSize   = 0;
68     m_odedcFlag     = 0;
69     m_bvodeM        = 0;
70     m_bvodeN        = 0;
71     m_mu            = 0;
72     m_ml            = 0;
73     m_bandedJac     = false;
74
75     m_wstrCaller = callerName;
76
77     // callable
78     m_pCallFFunction      = NULL;
79     m_pCallJacFunction    = NULL;
80     m_pCallGFunction      = NULL;
81     m_pCallPjacFunction   = NULL;
82     m_pCallPsolFunction   = NULL;
83
84     // function extern
85     m_pStringFFunctionDyn       = NULL;
86     m_pStringJacFunctionDyn     = NULL;
87     m_pStringGFunctionDyn       = NULL;
88     m_pStringPjacFunctionDyn    = NULL;
89     m_pStringPsolFunctionDyn    = NULL;
90
91     // function static
92     m_pStringFFunctionStatic    = NULL;
93     m_pStringJacFunctionStatic  = NULL;
94     m_pStringGFunctionStatic    = NULL;
95     m_pStringPjacFunctionStatic = NULL;
96     m_pStringPsolFunctionStatic = NULL;
97
98     // bvode
99     m_pCallFsubFunction     = NULL;
100     m_pCallDfsubFunction    = NULL;
101     m_pCallGsubFunction     = NULL;
102     m_pCallDgsubFunction    = NULL;
103     m_pCallGuessFunction    = NULL;
104
105     m_pStringFsubFunctionDyn    = NULL;
106     m_pStringDfsubFunctionDyn   = NULL;
107     m_pStringGsubFunctionDyn    = NULL;
108     m_pStringDgsubFunctionDyn   = NULL;
109     m_pStringGuessFunctionDyn   = NULL;
110
111     m_pStringFsubFunctionStatic     = NULL;
112     m_pStringDfsubFunctionStatic    = NULL;
113     m_pStringGsubFunctionStatic     = NULL;
114     m_pStringDgsubFunctionStatic    = NULL;
115     m_pStringGuessFunctionStatic    = NULL;
116
117     // init static functions
118     if (callerName == L"ode")
119     {
120         m_staticFunctionMap[L"arnol"]   = (void*) C2F(arnol);
121         m_staticFunctionMap[L"fex"]     = (void*) fex;
122         m_staticFunctionMap[L"fex2"]    = (void*) fex2;
123         m_staticFunctionMap[L"fex3"]    = (void*) fex3;
124         m_staticFunctionMap[L"fexab"]   = (void*) fexab;
125         m_staticFunctionMap[L"loren"]   = (void*) C2F(loren);
126         m_staticFunctionMap[L"bcomp"]   = (void*) C2F(bcomp);
127         m_staticFunctionMap[L"lcomp"]   = (void*) C2F(lcomp);
128
129         m_staticFunctionMap[L"jex"]     = (void*) jex;
130     }
131     else if (callerName == L"odedc")
132     {
133         m_staticFunctionMap[L"fcd"]     = (void*) fcd;
134         m_staticFunctionMap[L"fcd1"]    = (void*) fcd1;
135         m_staticFunctionMap[L"fexcd"]   = (void*) fexcd;
136         m_staticFunctionMap[L"phis"]    = (void*) phis;
137         m_staticFunctionMap[L"phit"]    = (void*) phit;
138
139         m_staticFunctionMap[L"jex"]     = (void*) jex;
140     }
141     else if (callerName == L"intg")
142     {
143         m_staticFunctionMap[L"intgex"]  = (void*) C2F(intgex);
144     }
145     else if (callerName == L"int2d")
146     {
147         m_staticFunctionMap[L"int2dex"] = (void*) C2F(int2dex);
148     }
149     else if (callerName == L"int3d")
150     {
151         m_staticFunctionMap[L"int3dex"] = (void*) C2F(int3dex);
152     }
153     else if (callerName == L"feval")
154     {
155         m_staticFunctionMap[L"parab"]   = (void*) C2F(parab);
156         m_staticFunctionMap[L"parabc"]  = (void*) C2F(parabc);
157     }
158     else if (callerName == L"bvode")
159     {
160         m_staticFunctionMap[L"cndg"]    = (void*) C2F(cndg);
161         m_staticFunctionMap[L"cng"]     = (void*) C2F(cng);
162         m_staticFunctionMap[L"cnf"]     = (void*) C2F(cnf);
163         m_staticFunctionMap[L"cndf"]    = (void*) C2F(cndf);
164         m_staticFunctionMap[L"cngu"]    = (void*) C2F(cngu);
165     }
166     else if (callerName == L"impl")
167     {
168         m_staticFunctionMap[L"resid"]   = (void*) C2F(resid);  // res
169         m_staticFunctionMap[L"aplusp"]  = (void*) C2F(aplusp); // adda
170         m_staticFunctionMap[L"dgbydy"]  = (void*) C2F(dgbydy); // jac
171     }
172     else if (callerName == L"dassl" ||
173              callerName == L"dasrt" ||
174              callerName == L"daskr")
175     {
176         //res
177         m_staticFunctionMap[L"res1"]    = (void*) C2F(res1);
178         m_staticFunctionMap[L"res2"]    = (void*) C2F(res2);
179         m_staticFunctionMap[L"dres1"]   = (void*) C2F(dres1);
180         m_staticFunctionMap[L"dres2"]   = (void*) C2F(dres2);
181
182         // jac
183         m_staticFunctionMap[L"jac2"]   = (void*) C2F(jac2);
184         m_staticFunctionMap[L"djac2"]  = (void*) C2F(djac2);
185         m_staticFunctionMap[L"djac1"]  = (void*) C2F(djac1);
186
187         //g
188         if (callerName == L"dasrt" || callerName == L"daskr")
189         {
190             m_staticFunctionMap[L"gr1"]  = (void*) C2F(gr1);
191             m_staticFunctionMap[L"gr2"]  = (void*) C2F(gr2);
192         }
193
194         // pjac, psol
195         if (callerName == L"daskr")
196         {
197             m_staticFunctionMap[L"pjac1"]  = (void*) pjac1;
198             m_staticFunctionMap[L"psol1"]  = (void*) psol1;
199         }
200     }
201 }
202
203 DifferentialEquationFunctions::~DifferentialEquationFunctions()
204 {
205     m_staticFunctionMap.clear();
206 }
207
208 /*------------------------------- public -------------------------------------------*/
209 void DifferentialEquationFunctions::execDasrtG(int* ny, double* t, double* y, int* ng, double* gout, double* rpar, int* ipar)
210 {
211     char errorMsg[256];
212     if (m_pCallGFunction)
213     {
214         callDasrtMacroG(ny, t, y, ng, gout, rpar, ipar);
215     }
216     else if (m_pStringGFunctionDyn)
217     {
218         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringGFunctionDyn->get(0));
219         if (func == NULL)
220         {
221             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringGFunctionDyn->get(0));
222             throw ast::InternalError(errorMsg);
223         }
224         ((dasrt_g_t)(func->functionPtr))(ny, t, y, ng, gout, rpar, ipar);
225     }
226     else if (m_pStringGFunctionStatic)
227     {
228         ((dasrt_g_t)m_staticFunctionMap[m_pStringGFunctionStatic->get(0)])(ny, t, y, ng, gout, rpar, ipar);
229     }
230     else
231     {
232         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "g");
233         throw ast::InternalError(errorMsg);
234     }
235 }
236
237 void DifferentialEquationFunctions::execDasslF(double* t, double* y, double* ydot, double* delta, int* ires, double* rpar, int* ipar)
238 {
239     char errorMsg[256];
240     if (m_pCallFFunction)
241     {
242         callDasslMacroF(t, y, ydot, delta, ires, rpar, ipar);
243     }
244     else if (m_pStringFFunctionDyn)
245     {
246         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringFFunctionDyn->get(0));
247         if (func == NULL)
248         {
249             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringFFunctionDyn->get(0));
250             throw ast::InternalError(errorMsg);
251         }
252         ((dassl_f_t)(func->functionPtr))(t, y, ydot, delta, ires, rpar, ipar);
253     }
254     else if (m_pStringFFunctionStatic)
255     {
256         ((dassl_f_t)m_staticFunctionMap[m_pStringFFunctionStatic->get(0)])(t, y, ydot, delta, ires, rpar, ipar);
257     }
258     else
259     {
260         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "f");
261         throw ast::InternalError(errorMsg);
262     }
263 }
264
265 void DifferentialEquationFunctions::execDasslJac(double* t, double* y, double* ydot, double* pd, double* cj, double* rpar, int* ipar)
266 {
267     char errorMsg[256];
268     if (m_pCallJacFunction)
269     {
270         callDasslMacroJac(t, y, ydot, pd, cj, rpar, ipar);
271     }
272     else if (m_pStringJacFunctionDyn)
273     {
274         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringJacFunctionDyn->get(0));
275         if (func == NULL)
276         {
277             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringJacFunctionDyn->get(0));
278             throw ast::InternalError(errorMsg);
279         }
280         ((dassl_jac_t)(func->functionPtr))(t, y, ydot, pd, cj, rpar, ipar);
281     }
282     else if (m_pStringJacFunctionStatic)
283     {
284         ((dassl_jac_t)m_staticFunctionMap[m_pStringJacFunctionStatic->get(0)])(t, y, ydot, pd, cj, rpar, ipar);
285     }
286     else
287     {
288         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "jacobian");
289         throw ast::InternalError(errorMsg);
290     }
291 }
292
293 void DifferentialEquationFunctions::execDaskrPjac(double* res, int* ires, int* neq, double* t, double* y, double* ydot,
294         double* rewt, double* savr, double* wk, double* h, double* cj,
295         double* wp, int* iwp, int* ier, double* rpar, int* ipar)
296 {
297     char errorMsg[256];
298     if (m_pCallPjacFunction)
299     {
300         callDaskrMacroPjac(res, ires, neq, t, y, ydot, rewt, savr,
301                            wk, h, cj, wp, iwp, ier, rpar, ipar);
302     }
303     else if (m_pStringPjacFunctionDyn)
304     {
305         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringPjacFunctionDyn->get(0));
306         if (func == NULL)
307         {
308             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringPjacFunctionDyn->get(0));
309             throw ast::InternalError(errorMsg);
310         }
311         ((daskr_pjac_t)(func->functionPtr))(res, ires, neq, t, y, ydot, rewt, savr,
312                                             wk, h, cj, wp, iwp, ier, rpar, ipar);
313     }
314     else if (m_pStringPjacFunctionStatic)
315     {
316         ((daskr_pjac_t)m_staticFunctionMap[m_pStringPjacFunctionStatic->get(0)])(res, ires, neq, t, y, ydot, rewt, savr,
317                 wk, h, cj, wp, iwp, ier, rpar, ipar);
318     }
319     else
320     {
321         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "pjac");
322         throw ast::InternalError(errorMsg);
323     }
324 }
325
326 void DifferentialEquationFunctions::execDaskrPsol(int* neq, double* t, double* y, double* ydot, double* savr, double* wk,
327         double* cj, double* wght, double* wp, int* iwp, double* b, double* eplin,
328         int* ier, double* rpar, int* ipar)
329 {
330     char errorMsg[256];
331     if (m_pCallPsolFunction)
332     {
333         callDaskrMacroPsol(neq, t, y, ydot, savr, wk, cj, wght,
334                            wp, iwp, b, eplin, ier, rpar, ipar);
335     }
336     else if (m_pStringPsolFunctionDyn)
337     {
338         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringPsolFunctionDyn->get(0));
339         if (func == NULL)
340         {
341             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringPsolFunctionDyn->get(0));
342             throw ast::InternalError(errorMsg);
343         }
344         ((daskr_psol_t)(func->functionPtr))(neq, t, y, ydot, savr, wk, cj, wght,
345                                             wp, iwp, b, eplin, ier, rpar, ipar);
346     }
347     else if (m_pStringPsolFunctionStatic)
348     {
349         ((daskr_psol_t)m_staticFunctionMap[m_pStringPsolFunctionStatic->get(0)])(neq, t, y, ydot, savr, wk, cj, wght,
350                 wp, iwp, b, eplin, ier, rpar, ipar);
351     }
352     else
353     {
354         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "psol");
355         throw ast::InternalError(errorMsg);
356     }
357 }
358
359 void DifferentialEquationFunctions::execImplF(int* neq, double* t, double* y, double* s, double* r, int* ires)
360 {
361     char errorMsg[256];
362     if (m_pCallFFunction)
363     {
364         callImplMacroF(neq, t, y, s, r, ires);
365     }
366     else if (m_pStringFFunctionDyn)
367     {
368         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringFFunctionDyn->get(0));
369         if (func == NULL)
370         {
371             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringFFunctionDyn->get(0));
372             throw ast::InternalError(errorMsg);
373         }
374         ((impl_f_t)(func->functionPtr))(neq, t, y, s, r, ires);
375     }
376     else if (m_pStringFFunctionStatic)
377     {
378         ((impl_f_t)m_staticFunctionMap[m_pStringFFunctionStatic->get(0)])(neq, t, y, s, r, ires);
379     }
380     else
381     {
382         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "f");
383         throw ast::InternalError(errorMsg);
384     }
385 }
386
387 void DifferentialEquationFunctions::execImplG(int* neq, double* t, double* y, double* ml, double* mu, double* p, int* nrowp)
388 {
389     char errorMsg[256];
390     if (m_pCallGFunction)
391     {
392         callImplMacroG(neq, t, y, ml, mu, p, nrowp);
393     }
394     else if (m_pStringGFunctionDyn)
395     {
396         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringGFunctionDyn->get(0));
397         if (func == NULL)
398         {
399             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringGFunctionDyn->get(0));
400             throw ast::InternalError(errorMsg);
401         }
402         ((impl_g_t)(func->functionPtr))(neq, t, y, ml, mu, p, nrowp);
403     }
404     else if (m_pStringGFunctionStatic)
405     {
406         ((impl_g_t)m_staticFunctionMap[m_pStringGFunctionStatic->get(0)])(neq, t, y, ml, mu, p, nrowp);
407     }
408     else
409     {
410         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "g");
411         throw ast::InternalError(errorMsg);
412     }
413 }
414
415 void DifferentialEquationFunctions::execImplJac(int* neq, double* t, double* y, double* s, double* ml, double* mu, double* p, int* nrowp)
416 {
417     char errorMsg[256];
418     if (m_pCallJacFunction)
419     {
420         callImplMacroJac(neq, t, y, s, ml, mu, p, nrowp);
421     }
422     else if (m_pStringJacFunctionDyn)
423     {
424         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringJacFunctionDyn->get(0));
425         if (func == NULL)
426         {
427             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringJacFunctionDyn->get(0));
428             throw ast::InternalError(errorMsg);
429         }
430         ((impl_jac_t)(func->functionPtr))(neq, t, y, s, ml, mu, p, nrowp);
431     }
432     else if (m_pStringJacFunctionStatic)
433     {
434         ((impl_jac_t)m_staticFunctionMap[m_pStringJacFunctionStatic->get(0)])(neq, t, y, s, ml, mu, p, nrowp);
435     }
436     else
437     {
438         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "jacobian");
439         throw ast::InternalError(errorMsg);
440     }
441 }
442
443 void DifferentialEquationFunctions::execBvodeGuess(double *x, double *z, double *d)
444 {
445     char errorMsg[256];
446     if (m_pCallGuessFunction)
447     {
448         callBvodeMacroGuess(x, z, d);
449     }
450     else if (m_pStringGuessFunctionDyn)
451     {
452         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringGuessFunctionDyn->get(0));
453         if (func == NULL)
454         {
455             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringGuessFunctionDyn->get(0));
456             throw ast::InternalError(errorMsg);
457         }
458         ((bvode_ddd_t)(func->functionPtr))(x, z, d);
459     }
460     else if (m_pStringGuessFunctionStatic)
461     {
462         ((bvode_ddd_t)m_staticFunctionMap[m_pStringGuessFunctionStatic->get(0)])(x, z, d);
463     }
464     else
465     {
466         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "guess");
467         throw ast::InternalError(errorMsg);
468     }
469 }
470
471 void DifferentialEquationFunctions::execBvodeDfsub(double *x, double *z, double *d)
472 {
473     char errorMsg[256];
474     if (m_pCallDfsubFunction)
475     {
476         callBvodeMacroDfsub(x, z, d);
477     }
478     else if (m_pStringDfsubFunctionDyn)
479     {
480         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringDfsubFunctionDyn->get(0));
481         if (func == NULL)
482         {
483             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringDfsubFunctionDyn->get(0));
484             throw ast::InternalError(errorMsg);
485         }
486         ((bvode_ddd_t)(func->functionPtr))(x, z, d);
487     }
488     else if (m_pStringDfsubFunctionStatic)// function static
489     {
490         ((bvode_ddd_t)m_staticFunctionMap[m_pStringDfsubFunctionStatic->get(0)])(x, z, d);
491     }
492     else
493     {
494         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "fsub");
495         throw ast::InternalError(errorMsg);
496     }
497 }
498
499 void DifferentialEquationFunctions::execBvodeFsub(double *x, double *z, double *d)
500 {
501     char errorMsg[256];
502     if (m_pCallFsubFunction)
503     {
504         callBvodeMacroFsub(x, z, d);
505     }
506     else if (m_pStringFsubFunctionDyn)
507     {
508         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringFsubFunctionDyn->get(0));
509         if (func == NULL)
510         {
511             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringFsubFunctionDyn->get(0));
512             throw ast::InternalError(errorMsg);
513         }
514         ((bvode_ddd_t)(func->functionPtr))(x, z, d);
515     }
516     else if (m_pStringFsubFunctionStatic) // function static
517     {
518         ((bvode_ddd_t)m_staticFunctionMap[m_pStringFsubFunctionStatic->get(0)])(x, z, d);
519     }
520     else
521     {
522         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "fsub");
523         throw ast::InternalError(errorMsg);
524     }
525 }
526
527 void DifferentialEquationFunctions::execBvodeDgsub(int *i, double *z, double *g)
528 {
529     char errorMsg[256];
530     if (m_pCallDgsubFunction)
531     {
532         callBvodeMacroDgsub(i, z, g);
533     }
534     else if (m_pStringDgsubFunctionDyn)
535     {
536         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringDgsubFunctionDyn->get(0));
537         if (func == NULL)
538         {
539             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringDgsubFunctionDyn->get(0));
540             throw ast::InternalError(errorMsg);
541         }
542         ((bvode_idd_t)(func->functionPtr))(i, z, g);
543     }
544     else if (m_pStringDgsubFunctionStatic) // function static
545     {
546         ((bvode_idd_t)m_staticFunctionMap[m_pStringDgsubFunctionStatic->get(0)])(i, z, g);
547     }
548     else
549     {
550         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "gsub");
551         throw ast::InternalError(errorMsg);
552     }
553 }
554
555 void DifferentialEquationFunctions::execBvodeGsub(int *i, double *z, double *g)
556 {
557     char errorMsg[256];
558     if (m_pCallGsubFunction)
559     {
560         callBvodeMacroGsub(i, z, g);
561     }
562     else if (m_pStringGsubFunctionDyn)
563     {
564         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringGsubFunctionDyn->get(0));
565         if (func == NULL)
566         {
567             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringGsubFunctionDyn->get(0));
568             throw ast::InternalError(errorMsg);
569         }
570         ((bvode_idd_t)(func->functionPtr))(i, z, g);
571     }
572     else if (m_pStringGsubFunctionStatic) // function static
573     {
574         ((bvode_idd_t)m_staticFunctionMap[m_pStringGsubFunctionStatic->get(0)])(i, z, g);
575     }
576     else
577     {
578         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "gsub");
579         throw ast::InternalError(errorMsg);
580     }
581 }
582
583 void DifferentialEquationFunctions::execFevalF(int *nn, double *x1, double *x2, double *xres, int *itype)
584 {
585     char errorMsg[256];
586     if (m_pCallFFunction)
587     {
588         callFevalMacroF(nn, x1, x2, xres, itype);
589     }
590     else if (m_pStringFFunctionDyn)
591     {
592         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringFFunctionDyn->get(0));
593         if (func == NULL)
594         {
595             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringFFunctionDyn->get(0));
596             throw ast::InternalError(errorMsg);
597         }
598
599         ((feval_f_t)(func->functionPtr))(nn, x1, x2, xres, itype);
600     }
601     else if (m_pStringFFunctionStatic) // function static
602     {
603         ((feval_f_t)m_staticFunctionMap[m_pStringFFunctionStatic->get(0)])(nn, x1, x2, xres, itype);
604     }
605     else
606     {
607         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "f");
608         throw ast::InternalError(errorMsg);
609     }
610 }
611
612 void DifferentialEquationFunctions::execInt3dF(double* x, int* numfun, double* funvls)
613 {
614     char errorMsg[256];
615     if (m_pCallFFunction)
616     {
617         callInt3dMacroF(x, numfun, funvls);
618     }
619     else if (m_pStringFFunctionDyn)
620     {
621         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringFFunctionDyn->get(0));
622         if (func == NULL)
623         {
624             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringFFunctionDyn->get(0));
625             throw ast::InternalError(errorMsg);
626         }
627         ((int3d_f_t)(func->functionPtr))(x, numfun, funvls);
628     }
629     else if (m_pStringFFunctionStatic) // function static
630     {
631         ((int3d_f_t)m_staticFunctionMap[m_pStringFFunctionStatic->get(0)])(x, numfun, funvls);
632     }
633     else
634     {
635         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "f");
636         throw ast::InternalError(errorMsg);
637     }
638 }
639
640 double DifferentialEquationFunctions::execInt2dF(double* x, double* y)
641 {
642     char errorMsg[256];
643     if (m_pCallFFunction)
644     {
645         return callInt2dMacroF(x, y);
646     }
647     else if (m_pStringFFunctionDyn)
648     {
649         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringFFunctionDyn->get(0));
650         if (func == NULL)
651         {
652             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringFFunctionDyn->get(0));
653             throw ast::InternalError(errorMsg);
654         }
655         return ((int2d_f_t)(func->functionPtr))(x, y);
656     }
657     else if (m_pStringFFunctionStatic) // function static
658     {
659         return ((int2d_f_t)m_staticFunctionMap[m_pStringFFunctionStatic->get(0)])(x, y);
660     }
661     else
662     {
663         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "f");
664         throw ast::InternalError(errorMsg);
665     }
666 }
667
668 double DifferentialEquationFunctions::execIntgF(double* x)
669 {
670     char errorMsg[256];
671     if (m_pCallFFunction)
672     {
673         return callIntgMacroF(x);
674     }
675     else if (m_pStringFFunctionDyn)
676     {
677         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringFFunctionDyn->get(0));
678         if (func == NULL)
679         {
680             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringFFunctionDyn->get(0));
681             throw ast::InternalError(errorMsg);
682         }
683         return ((intg_f_t)(func->functionPtr))(x);
684     }
685     else if (m_pStringFFunctionStatic) // function static
686     {
687         return ((intg_f_t)m_staticFunctionMap[m_pStringFFunctionStatic->get(0)])(x);
688     }
689     else
690     {
691         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "f");
692         throw ast::InternalError(errorMsg);
693     }
694 }
695
696 void DifferentialEquationFunctions::execOdeF(int* n, double* t, double* y, double* yout)
697 {
698     char errorMsg[256];
699     if (m_pCallFFunction)
700     {
701         callOdeMacroF(n, t, y, yout);
702     }
703     else if (m_pStringFFunctionDyn)
704     {
705         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringFFunctionDyn->get(0));
706         if (func == NULL)
707         {
708             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringFFunctionDyn->get(0));
709             throw ast::InternalError(errorMsg);
710         }
711
712         if (m_wstrCaller == L"ode")
713         {
714             ((ode_f_t)(func->functionPtr))(n, t, y, yout);
715         }
716         else
717         {
718             ((odedc_f_t)(func->functionPtr))(&m_odedcFlag, n, &m_odedcYDSize, t, y, yout);
719         }
720     }
721     else if (m_pStringFFunctionStatic) // function static
722     {
723         if (m_wstrCaller == L"ode")
724         {
725             ((ode_f_t)m_staticFunctionMap[m_pStringFFunctionStatic->get(0)])(n, t, y, yout);
726         }
727         else // if (m_wstrCaller == L"odedc")
728         {
729             ((odedc_f_t)m_staticFunctionMap[m_pStringFFunctionStatic->get(0)])(&m_odedcFlag, n, &m_odedcYDSize, t, y, yout);
730         }
731     }
732     else
733     {
734         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "f");
735         throw ast::InternalError(errorMsg);
736     }
737 }
738
739 void DifferentialEquationFunctions::execFunctionJac(int *n, double *t, double *y, int *ml, int *mu, double *J, int *nrpd)
740 {
741     char errorMsg[256];
742     if (m_pCallJacFunction)
743     {
744         callMacroJac(n, t, y, ml, mu, J, nrpd);
745     }
746     else if (m_pStringJacFunctionDyn)
747     {
748         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringJacFunctionDyn->get(0));
749         if (func == NULL)
750         {
751             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringJacFunctionDyn->get(0));
752             throw ast::InternalError(errorMsg);
753         }
754         ((func_jac_t)(func->functionPtr))(n, t, y, ml, mu, J, nrpd);
755     }
756     else if (m_pStringJacFunctionStatic) // function static
757     {
758         ((func_jac_t)m_staticFunctionMap[m_pStringJacFunctionStatic->get(0)])(n, t, y, ml, mu, J, nrpd);
759     }
760     else
761     {
762         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "jacobian");
763         throw ast::InternalError(errorMsg);
764     }
765 }
766
767 void DifferentialEquationFunctions::execFunctionG(int* n, double* t, double* y, int* ng, double* gout)
768 {
769     char errorMsg[256];
770     if (m_pCallGFunction)
771     {
772         callMacroG(n, t, y, ng, gout);
773     }
774     else if (m_pStringGFunctionDyn)
775     {
776         ConfigVariable::EntryPointStr* func = ConfigVariable::getEntryPoint(m_pStringGFunctionDyn->get(0));
777         if (func == NULL)
778         {
779             sprintf(errorMsg, _("Undefined fonction '%ls'.\n"), m_pStringGFunctionDyn->get(0));
780             throw ast::InternalError(errorMsg);
781         }
782         ((func_g_t)(func->functionPtr))(n, t, y, ng, gout);
783     }
784     else if (m_pStringGFunctionStatic)// function static
785     {
786         ((func_g_t)m_staticFunctionMap[m_pStringGFunctionStatic->get(0)])(n, t, y, ng, gout);
787     }
788     else
789     {
790         sprintf(errorMsg, _("User function '%s' have not been setted.\n"), "g");
791         throw ast::InternalError(errorMsg);
792     }
793 }
794
795 //*** setter ***
796 // set rows cols
797 void DifferentialEquationFunctions::setOdeYRows(int rows)
798 {
799     m_odeYRows = rows;
800 }
801
802 void DifferentialEquationFunctions::setOdeYCols(int cols)
803 {
804     m_odeYCols = cols;
805 }
806
807 // set odedc yd size
808 void DifferentialEquationFunctions::setOdedcYDSize(int size)
809 {
810     m_odedcYDSize = size;
811 }
812
813 // set odedc flag
814 void DifferentialEquationFunctions::setOdedcFlag()
815 {
816     m_odedcFlag = 1;
817 }
818
819 // reset odedc flag
820 void DifferentialEquationFunctions::resetOdedcFlag()
821 {
822     m_odedcFlag = 0;
823 }
824
825 void DifferentialEquationFunctions::setBvodeM(int _m)
826 {
827     m_bvodeM = _m;
828 }
829
830 void DifferentialEquationFunctions::setBvodeN(int _n)
831 {
832     m_bvodeN = _n;
833 }
834
835 //set function f, jac, g, psol, pjac as types::Callable
836 void DifferentialEquationFunctions::setFFunction(types::Callable* _odeFFunc)
837 {
838     m_pCallFFunction = _odeFFunc;
839 }
840
841 void DifferentialEquationFunctions::setJacFunction(types::Callable* _odeJacFunc)
842 {
843     m_pCallJacFunction = _odeJacFunc;
844 }
845
846 void DifferentialEquationFunctions::setGFunction(types::Callable* _odeGFunc)
847 {
848     m_pCallGFunction = _odeGFunc;
849 }
850
851 void DifferentialEquationFunctions::setPsolFunction(types::Callable* _pSolFunc)
852 {
853     m_pCallPsolFunction = _pSolFunc;
854 }
855
856 void DifferentialEquationFunctions::setPjacFunction(types::Callable* _pJacFunc)
857 {
858     m_pCallPjacFunction = _pJacFunc;
859 }
860
861 //set function f, jac, g, psol, pjac as types::String
862 bool DifferentialEquationFunctions::setFFunction(types::String* _odeFFunc)
863 {
864     if (ConfigVariable::getEntryPoint(_odeFFunc->get(0)))
865     {
866         m_pStringFFunctionDyn = _odeFFunc;
867         return true;
868     }
869     else
870     {
871         if (m_staticFunctionMap.find(_odeFFunc->get(0)) != m_staticFunctionMap.end())
872         {
873             m_pStringFFunctionStatic = _odeFFunc;
874             return true;
875         }
876         return false;
877     }
878 }
879
880 bool DifferentialEquationFunctions::setJacFunction(types::String* _odeJacFunc)
881 {
882     if (ConfigVariable::getEntryPoint(_odeJacFunc->get(0)))
883     {
884         m_pStringJacFunctionDyn = _odeJacFunc;
885         return true;
886     }
887     else
888     {
889         if (m_staticFunctionMap.find(_odeJacFunc->get(0)) != m_staticFunctionMap.end())
890         {
891             m_pStringJacFunctionStatic = _odeJacFunc;
892             return true;
893         }
894         return false;
895     }
896 }
897
898 bool DifferentialEquationFunctions::setGFunction(types::String* _odeGFunc)
899 {
900     if (ConfigVariable::getEntryPoint(_odeGFunc->get(0)))
901     {
902         m_pStringGFunctionDyn = _odeGFunc;
903         return true;
904     }
905     else
906     {
907         if (m_staticFunctionMap.find(_odeGFunc->get(0)) != m_staticFunctionMap.end())
908         {
909             m_pStringGFunctionStatic = _odeGFunc;
910             return true;
911         }
912         return false;
913     }
914 }
915
916 bool DifferentialEquationFunctions::setPsolFunction(types::String* _pSolFunc)
917 {
918     if (ConfigVariable::getEntryPoint(_pSolFunc->get(0)))
919     {
920         m_pStringPsolFunctionDyn = _pSolFunc;
921         return true;
922     }
923     else
924     {
925         if (m_staticFunctionMap.find(_pSolFunc->get(0)) != m_staticFunctionMap.end())
926         {
927             m_pStringPsolFunctionStatic = _pSolFunc;
928             return true;
929         }
930         return false;
931     }
932 }
933
934 bool DifferentialEquationFunctions::setPjacFunction(types::String* _pJacFunc)
935 {
936     if (ConfigVariable::getEntryPoint(_pJacFunc->get(0)))
937     {
938         m_pStringPjacFunctionDyn = _pJacFunc;
939         return true;
940     }
941     else
942     {
943         if (m_staticFunctionMap.find(_pJacFunc->get(0)) != m_staticFunctionMap.end())
944         {
945             m_pStringPjacFunctionStatic = _pJacFunc;
946             return true;
947         }
948         return false;
949     }
950 }
951
952 // set args for f, jac, g, pjac and psol functions
953 void DifferentialEquationFunctions::setFArgs(types::InternalType* _odeFArg)
954 {
955     m_FArgs.push_back(_odeFArg);
956 }
957
958 void DifferentialEquationFunctions::setJacArgs(types::InternalType* _odeJacArg)
959 {
960     m_JacArgs.push_back(_odeJacArg);
961 }
962
963 void DifferentialEquationFunctions::setGArgs(types::InternalType* _odeGArg)
964 {
965     m_odeGArgs.push_back(_odeGArg);
966 }
967
968 void DifferentialEquationFunctions::setPsolArgs(types::InternalType* _pSolArg)
969 {
970     m_pSolArgs.push_back(_pSolArg);
971 }
972
973 void DifferentialEquationFunctions::setPjacArgs(types::InternalType* _pJacArg)
974 {
975     m_pJacArgs.push_back(_pJacArg);
976 }
977
978 // bvode set function as types::Callable gsub, dgsub, fsub, dfsub, guess
979 void DifferentialEquationFunctions::setGsubFunction(types::Callable* _func)
980 {
981     m_pCallGsubFunction = _func;
982 }
983
984 void DifferentialEquationFunctions::setDgsubFunction(types::Callable* _func)
985 {
986     m_pCallDgsubFunction = _func;
987 }
988
989 void DifferentialEquationFunctions::setFsubFunction(types::Callable* _func)
990 {
991     m_pCallFsubFunction = _func;
992 }
993
994 void DifferentialEquationFunctions::setDfsubFunction(types::Callable* _func)
995 {
996     m_pCallDfsubFunction = _func;
997 }
998
999 void DifferentialEquationFunctions::setGuessFunction(types::Callable* _func)
1000 {
1001     m_pCallGuessFunction = _func;
1002 }
1003
1004 // bvode set function as types::String gsub, dgsub, fsub, dfsub, guess
1005 bool DifferentialEquationFunctions::setGsubFunction(types::String* _func)
1006 {
1007     if (ConfigVariable::getEntryPoint(_func->get(0)))
1008     {
1009         m_pStringGsubFunctionDyn = _func;
1010         return true;
1011     }
1012     else
1013     {
1014         if (m_staticFunctionMap.find(_func->get(0)) != m_staticFunctionMap.end())
1015         {
1016             m_pStringGsubFunctionStatic = _func;
1017             return true;
1018         }
1019         return false;
1020     }
1021 }
1022
1023 bool DifferentialEquationFunctions::setDgsubFunction(types::String* _func)
1024 {
1025     if (ConfigVariable::getEntryPoint(_func->get(0)))
1026     {
1027         m_pStringDgsubFunctionDyn = _func;
1028         return true;
1029     }
1030     else
1031     {
1032         if (m_staticFunctionMap.find(_func->get(0)) != m_staticFunctionMap.end())
1033         {
1034             m_pStringDgsubFunctionStatic = _func;
1035             return true;
1036         }
1037         return false;
1038     }
1039 }
1040
1041 bool DifferentialEquationFunctions::setFsubFunction(types::String* _func)
1042 {
1043     if (ConfigVariable::getEntryPoint(_func->get(0)))
1044     {
1045         m_pStringFsubFunctionDyn = _func;
1046         return true;
1047     }
1048     else
1049     {
1050         if (m_staticFunctionMap.find(_func->get(0)) != m_staticFunctionMap.end())
1051         {
1052             m_pStringFsubFunctionStatic = _func;
1053             return true;
1054         }
1055         return false;
1056     }
1057 }
1058
1059 bool DifferentialEquationFunctions::setDfsubFunction(types::String* _func)
1060 {
1061     if (ConfigVariable::getEntryPoint(_func->get(0)))
1062     {
1063         m_pStringDfsubFunctionDyn = _func;
1064         return true;
1065     }
1066     else
1067     {
1068         if (m_staticFunctionMap.find(_func->get(0)) != m_staticFunctionMap.end())
1069         {
1070             m_pStringDfsubFunctionStatic = _func;
1071             return true;
1072         }
1073         return false;
1074     }
1075 }
1076
1077 bool DifferentialEquationFunctions::setGuessFunction(types::String* _func)
1078 {
1079     if (ConfigVariable::getEntryPoint(_func->get(0)))
1080     {
1081         m_pStringGuessFunctionDyn = _func;
1082         return true;
1083     }
1084     else
1085     {
1086         if (m_staticFunctionMap.find(_func->get(0)) != m_staticFunctionMap.end())
1087         {
1088             m_pStringGuessFunctionStatic = _func;
1089             return true;
1090         }
1091         return false;
1092     }
1093 }
1094
1095 // bvode set set args for gsub, dgsub, fsub, dfsub, guess functions
1096 void DifferentialEquationFunctions::setGsubArgs(types::InternalType* _arg)
1097 {
1098     m_GsubArgs.push_back(_arg);
1099 }
1100
1101 void DifferentialEquationFunctions::setDgsubArgs(types::InternalType* _arg)
1102 {
1103     m_DgsubArgs.push_back(_arg);
1104 }
1105
1106 void DifferentialEquationFunctions::setFsubArgs(types::InternalType* _arg)
1107 {
1108     m_FsubArgs.push_back(_arg);
1109 }
1110
1111 void DifferentialEquationFunctions::setDfsubArgs(types::InternalType* _arg)
1112 {
1113     m_DfsubArgs.push_back(_arg);
1114 }
1115
1116 void DifferentialEquationFunctions::setGuessArgs(types::InternalType* _arg)
1117 {
1118     m_GuessArgs.push_back(_arg);
1119 }
1120
1121 // set mu and ml
1122 void DifferentialEquationFunctions::setMu(int mu)
1123 {
1124     m_bandedJac = true;
1125     m_mu = mu;
1126 }
1127
1128 void DifferentialEquationFunctions::setMl(int ml)
1129 {
1130     m_bandedJac = true;
1131     m_ml = ml;
1132 }
1133
1134 //*** getter ***
1135 // get y rows cols
1136 int DifferentialEquationFunctions::getOdeYRows()
1137 {
1138     return m_odeYRows;
1139 }
1140
1141 int DifferentialEquationFunctions::getOdeYCols()
1142 {
1143     return m_odeYCols;
1144 }
1145
1146 // get odedc yd size
1147 int DifferentialEquationFunctions::getOdedcYDSize()
1148 {
1149     return m_odedcYDSize;
1150 }
1151
1152 // get odedc flag
1153 int DifferentialEquationFunctions::getOdedcFlag()
1154 {
1155     return m_odedcFlag;
1156 }
1157
1158 /*------------------------------- private -------------------------------------------*/
1159 void DifferentialEquationFunctions::callOdeMacroF(int* n, double* t, double* y, double* ydot)
1160 {
1161     char errorMsg[256];
1162     int one         = 1;
1163     int iRetCount   = 1;
1164
1165     typed_list in;
1166     typed_list out;
1167     types::optional_list opt;
1168     ast::ExecVisitor execFunc;
1169
1170     types::Double* pDblY    = NULL;
1171     types::Double* pDblYC   = NULL;
1172     types::Double* pDblYD   = NULL;
1173     types::Double* pDblFlag = NULL;
1174
1175     // create input args
1176     types::Double* pDblT = new types::Double(*t);
1177     pDblT->IncreaseRef();
1178
1179     if (m_odedcYDSize) // odedc
1180     {
1181         pDblYC = new types::Double(*n, 1);
1182         pDblYC->set(y);
1183         pDblYC->IncreaseRef();
1184         pDblYD = new types::Double(m_odedcYDSize, 1);
1185         pDblYD->set(y + *n);
1186         pDblYD->IncreaseRef();
1187         pDblFlag = new types::Double(m_odedcFlag);
1188         pDblFlag->IncreaseRef();
1189     }
1190     else // ode
1191     {
1192         pDblY = new types::Double(m_odeYRows, m_odeYCols);
1193         pDblY->set(y);
1194         pDblY->IncreaseRef();
1195     }
1196
1197     // push_back
1198     in.push_back(pDblT);
1199     if (m_odedcYDSize) // odedc
1200     {
1201         in.push_back(pDblYC);
1202         in.push_back(pDblYD);
1203         in.push_back(pDblFlag);
1204     }
1205     else
1206     {
1207         in.push_back(pDblY);
1208     }
1209
1210     for (int i = 0; i < (int)m_FArgs.size(); i++)
1211     {
1212         m_FArgs[i]->IncreaseRef();
1213         in.push_back(m_FArgs[i]);
1214     }
1215
1216     try
1217     {
1218         // new std::wstring(L"") is delete in destructor of ast::CommentExp
1219         m_pCallFFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
1220     }
1221     catch (const ast::InternalError& ie)
1222     {
1223         for (int i = 0; i < (int)m_FArgs.size(); i++)
1224         {
1225             m_FArgs[i]->DecreaseRef();
1226         }
1227
1228         throw ie;
1229     }
1230
1231     for (int i = 0; i < (int)m_FArgs.size(); i++)
1232     {
1233         m_FArgs[i]->DecreaseRef();
1234     }
1235
1236     if (out.size() != iRetCount)
1237     {
1238         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1239         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
1240         FREE(pstrName);
1241         throw ast::InternalError(errorMsg);
1242     }
1243
1244     out[0]->IncreaseRef();
1245
1246     pDblT->DecreaseRef();
1247     if (pDblT->isDeletable())
1248     {
1249         delete pDblT;
1250     }
1251
1252     if (m_odedcYDSize) // odedc
1253     {
1254         pDblYC->DecreaseRef();
1255         if (pDblYC->isDeletable())
1256         {
1257             delete pDblYC;
1258         }
1259         pDblYD->DecreaseRef();
1260         if (pDblYD->isDeletable())
1261         {
1262             delete pDblYD;
1263         }
1264         pDblFlag->DecreaseRef();
1265         if (pDblFlag->isDeletable())
1266         {
1267             delete pDblFlag;
1268         }
1269     }
1270     else
1271     {
1272         pDblY->DecreaseRef();
1273         if (pDblY->isDeletable())
1274         {
1275             delete pDblY;
1276         }
1277     }
1278
1279     out[0]->DecreaseRef();
1280
1281     if (out[0]->isDouble() == false)
1282     {
1283         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1284         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
1285         FREE(pstrName);
1286         throw ast::InternalError(errorMsg);
1287     }
1288     types::Double* pDblOut = out[0]->getAs<types::Double>();
1289     if (pDblOut->isComplex())
1290     {
1291         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1292         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
1293         FREE(pstrName);
1294         throw ast::InternalError(errorMsg);
1295     }
1296
1297     if (m_odedcFlag && m_odedcYDSize)
1298     {
1299         C2F(dcopy)(&m_odedcYDSize, pDblOut->get(), &one, ydot, &one);
1300     }
1301     else
1302     {
1303         C2F(dcopy)(n, pDblOut->get(), &one, ydot, &one);
1304     }
1305
1306     if (out[0]->isDeletable())
1307     {
1308         delete out[0];
1309     }
1310 }
1311
1312 void DifferentialEquationFunctions::callMacroJac(int* n, double* t, double* y, int* ml, int* mu, double* J, int* nrpd)
1313 {
1314     char errorMsg[256];
1315     int iRetCount   = 1;
1316     int one         = 1;
1317     int iMaxSize    = (*n) * (*nrpd);
1318
1319     typed_list in;
1320     typed_list out;
1321     types::optional_list opt;
1322     ast::ExecVisitor execFunc;
1323
1324     types::Double* pDblY = new types::Double(m_odeYRows, m_odeYCols);
1325     pDblY->set(y);
1326     types::Double* pDblT = new types::Double(*t);
1327
1328     pDblT->IncreaseRef();
1329     pDblY->IncreaseRef();
1330
1331     in.push_back(pDblT);
1332     in.push_back(pDblY);
1333
1334     for (int i = 0; i < (int)m_JacArgs.size(); i++)
1335     {
1336         m_JacArgs[i]->IncreaseRef();
1337         in.push_back(m_JacArgs[i]);
1338     }
1339
1340     try
1341     {
1342         // new std::wstring(L"") is delete in destructor of ast::CommentExp
1343         m_pCallJacFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
1344     }
1345     catch (const ast::InternalError& ie)
1346     {
1347         for (int i = 0; i < (int)m_JacArgs.size(); i++)
1348         {
1349             m_JacArgs[i]->DecreaseRef();
1350         }
1351
1352         throw ie;
1353     }
1354
1355     for (int i = 0; i < (int)m_JacArgs.size(); i++)
1356     {
1357         m_JacArgs[i]->DecreaseRef();
1358     }
1359
1360     out[0]->IncreaseRef();
1361     pDblT->DecreaseRef();
1362     pDblY->DecreaseRef();
1363
1364     if (pDblT->isDeletable())
1365     {
1366         delete pDblT;
1367     }
1368
1369     if (pDblY->isDeletable())
1370     {
1371         delete pDblY;
1372     }
1373
1374     if (out.size() != iRetCount)
1375     {
1376         char* pstrName = wide_string_to_UTF8(m_pCallJacFunction->getName().c_str());
1377         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
1378         FREE(pstrName);
1379         throw ast::InternalError(errorMsg);
1380     }
1381
1382     out[0]->DecreaseRef();
1383     if (out[0]->isDouble() == false)
1384     {
1385         char* pstrName = wide_string_to_UTF8(m_pCallJacFunction->getName().c_str());
1386         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
1387         FREE(pstrName);
1388         throw ast::InternalError(errorMsg);
1389     }
1390
1391
1392     types::Double* pDblOut = out[0]->getAs<types::Double>();
1393     int iSizeOut = pDblOut->getSize();
1394
1395     if (iSizeOut > iMaxSize)
1396     {
1397         char* pstrName = wide_string_to_UTF8(m_pCallJacFunction->getName().c_str());
1398         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A size less or equal than %d expected.\n"), pstrName, 1, iMaxSize);
1399         FREE(pstrName);
1400         throw ast::InternalError(errorMsg);
1401     }
1402
1403     C2F(dcopy)(&iSizeOut, pDblOut->get(), &one, J, &one);
1404 }
1405
1406 void DifferentialEquationFunctions::callMacroG(int* n, double* t, double* y, int* ng, double* gout)
1407 {
1408     char errorMsg[256];
1409     int iRetCount   = 1;
1410     int one         = 1;
1411
1412     typed_list in;
1413     typed_list out;
1414     types::optional_list opt;
1415     ast::ExecVisitor execFunc;
1416
1417     types::Double* pDblY = new types::Double(m_odeYRows, m_odeYCols);
1418     pDblY->set(y);
1419     types::Double* pDblT = new types::Double(*t);
1420
1421     pDblT->IncreaseRef();
1422     pDblY->IncreaseRef();
1423
1424     in.push_back(pDblT);
1425     in.push_back(pDblY);
1426
1427     for (int i = 0; i < (int)m_odeGArgs.size(); i++)
1428     {
1429         m_odeGArgs[i]->IncreaseRef();
1430         in.push_back(m_odeGArgs[i]);
1431     }
1432
1433     try
1434     {
1435         // new std::wstring(L"") is delete in destructor of ast::CommentExp
1436         m_pCallGFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
1437     }
1438     catch (const ast::InternalError& ie)
1439     {
1440         for (int i = 0; i < (int)m_odeGArgs.size(); i++)
1441         {
1442             m_odeGArgs[i]->DecreaseRef();
1443         }
1444
1445         throw ie;
1446     }
1447
1448     for (int i = 0; i < (int)m_odeGArgs.size(); i++)
1449     {
1450         m_odeGArgs[i]->DecreaseRef();
1451     }
1452
1453     if (out.size() != iRetCount)
1454     {
1455         char* pstrName = wide_string_to_UTF8(m_pCallGFunction->getName().c_str());
1456         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
1457         FREE(pstrName);
1458         throw ast::InternalError(errorMsg);
1459     }
1460
1461     out[0]->IncreaseRef();
1462
1463     pDblT->DecreaseRef();
1464     pDblY->DecreaseRef();
1465
1466     if (pDblT->isDeletable())
1467     {
1468         delete pDblT;
1469     }
1470
1471     if (pDblY->isDeletable())
1472     {
1473         delete pDblY;
1474     }
1475
1476     out[0]->DecreaseRef();
1477     if (out[0]->isDouble() == false)
1478     {
1479         char* pstrName = wide_string_to_UTF8(m_pCallGFunction->getName().c_str());
1480         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
1481         FREE(pstrName);
1482         throw ast::InternalError(errorMsg);
1483     }
1484
1485     C2F(dcopy)(ng, out[0]->getAs<types::Double>()->get(), &one, gout, &one);
1486     if (out[0]->isDeletable())
1487     {
1488         delete out[0];
1489     }
1490 }
1491
1492 double DifferentialEquationFunctions::callIntgMacroF(double* t)
1493 {
1494     char errorMsg[256];
1495     int one         = 1;
1496     int iRetCount   = 1;
1497
1498     typed_list in;
1499     typed_list out;
1500     types::optional_list opt;
1501     ast::ExecVisitor execFunc;
1502
1503     // create input args
1504     types::Double* pDblT = new types::Double(*t);
1505     pDblT->IncreaseRef();
1506
1507     // push_back
1508     in.push_back(pDblT);
1509
1510     for (int i = 0; i < (int)m_FArgs.size(); i++)
1511     {
1512         m_FArgs[i]->IncreaseRef();
1513         in.push_back(m_FArgs[i]);
1514     }
1515
1516     try
1517     {
1518         // new std::wstring(L"") is delete in destructor of ast::CommentExp
1519         m_pCallFFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
1520     }
1521     catch (const ast::InternalError& ie)
1522     {
1523         for (int i = 0; i < (int)m_FArgs.size(); i++)
1524         {
1525             m_FArgs[i]->DecreaseRef();
1526         }
1527
1528         throw ie;
1529     }
1530
1531     for (int i = 0; i < (int)m_FArgs.size(); i++)
1532     {
1533         m_FArgs[i]->DecreaseRef();
1534     }
1535
1536     if (out.size() != iRetCount)
1537     {
1538         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1539         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
1540         FREE(pstrName);
1541         throw ast::InternalError(errorMsg);
1542     }
1543
1544     out[0]->IncreaseRef();
1545
1546     pDblT->DecreaseRef();
1547     if (pDblT->isDeletable())
1548     {
1549         delete pDblT;
1550     }
1551
1552     out[0]->DecreaseRef();
1553     if (out[0]->isDouble() == false)
1554     {
1555         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1556         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
1557         FREE(pstrName);
1558         throw ast::InternalError(errorMsg);
1559
1560     }
1561
1562     types::Double* pDblOut = out[0]->getAs<types::Double>();
1563     if (pDblOut->getSize() != 1)
1564     {
1565         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1566         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A Scalar expected.\n"), pstrName, 1);
1567         FREE(pstrName);
1568         throw ast::InternalError(errorMsg);
1569     }
1570
1571     double res = pDblOut->get(0);
1572     if (out[0]->isDeletable())
1573     {
1574         delete out[0];
1575     }
1576
1577     return res;
1578 }
1579
1580 double DifferentialEquationFunctions::callInt2dMacroF(double* x, double* y)
1581 {
1582     char errorMsg[256];
1583     int one         = 1;
1584     int iRetCount   = 1;
1585
1586     typed_list in;
1587     typed_list out;
1588     types::optional_list opt;
1589     ast::ExecVisitor execFunc;
1590
1591     // create input args
1592     types::Double* pDblX = new types::Double(*x);
1593     pDblX->IncreaseRef();
1594     types::Double* pDblY = new types::Double(*y);
1595     pDblY->IncreaseRef();
1596
1597     // push_back
1598     in.push_back(pDblX);
1599     in.push_back(pDblY);
1600
1601     for (int i = 0; i < (int)m_FArgs.size(); i++)
1602     {
1603         m_FArgs[i]->IncreaseRef();
1604         in.push_back(m_FArgs[i]);
1605     }
1606
1607     try
1608     {
1609         // new std::wstring(L"") is delete in destructor of ast::CommentExp
1610         m_pCallFFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
1611     }
1612     catch (const ast::InternalError& ie)
1613     {
1614         for (int i = 0; i < (int)m_FArgs.size(); i++)
1615         {
1616             m_FArgs[i]->DecreaseRef();
1617         }
1618
1619         throw ie;
1620     }
1621
1622     for (int i = 0; i < (int)m_FArgs.size(); i++)
1623     {
1624         m_FArgs[i]->DecreaseRef();
1625     }
1626
1627     if (out.size() != iRetCount)
1628     {
1629         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1630         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
1631         FREE(pstrName);
1632         throw ast::InternalError(errorMsg);
1633     }
1634
1635     out[0]->IncreaseRef();
1636
1637     pDblX->DecreaseRef();
1638     if (pDblX->isDeletable())
1639     {
1640         delete pDblX;
1641     }
1642
1643     pDblY->DecreaseRef();
1644     if (pDblY->isDeletable())
1645     {
1646         delete pDblY;
1647     }
1648
1649     out[0]->DecreaseRef();
1650     if (out[0]->isDouble() == false)
1651     {
1652         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1653         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
1654         FREE(pstrName);
1655         throw ast::InternalError(errorMsg);
1656     }
1657
1658     types::Double* pDblOut = out[0]->getAs<types::Double>();
1659     if (pDblOut->getSize() != 1)
1660     {
1661         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1662         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A Scalar expected.\n"), pstrName, 1);
1663         FREE(pstrName);
1664         throw ast::InternalError(errorMsg);
1665     }
1666
1667     double res = pDblOut->get(0);
1668     if (out[0]->isDeletable())
1669     {
1670         delete out[0];
1671     }
1672
1673     return res;
1674 }
1675
1676 void DifferentialEquationFunctions::callInt3dMacroF(double* xyz, int* numfun, double* funvls)
1677 {
1678     char errorMsg[256];
1679     int one         = 1;
1680     int iRetCount   = 1;
1681
1682     typed_list in;
1683     typed_list out;
1684     types::optional_list opt;
1685     ast::ExecVisitor execFunc;
1686
1687     // create input args
1688     types::Double* pDblXYZ = new types::Double(3, 1);
1689     pDblXYZ->set(xyz);
1690     pDblXYZ->IncreaseRef();
1691     types::Double* pDblNumfun = new types::Double(*numfun);
1692     pDblNumfun->IncreaseRef();
1693
1694     // push_back
1695     in.push_back(pDblXYZ);
1696     in.push_back(pDblNumfun);
1697
1698     for (int i = 0; i < (int)m_FArgs.size(); i++)
1699     {
1700         m_FArgs[i]->IncreaseRef();
1701         in.push_back(m_FArgs[i]);
1702     }
1703
1704     try
1705     {
1706         // new std::wstring(L"") is delete in destructor of ast::CommentExp
1707         m_pCallFFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
1708     }
1709     catch (const ast::InternalError& ie)
1710     {
1711         for (int i = 0; i < (int)m_FArgs.size(); i++)
1712         {
1713             m_FArgs[i]->DecreaseRef();
1714         }
1715
1716         throw ie;
1717     }
1718
1719     for (int i = 0; i < (int)m_FArgs.size(); i++)
1720     {
1721         m_FArgs[i]->DecreaseRef();
1722     }
1723
1724     if (out.size() != iRetCount)
1725     {
1726         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1727         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
1728         FREE(pstrName);
1729         throw ast::InternalError(errorMsg);
1730     }
1731
1732     out[0]->IncreaseRef();
1733
1734     pDblXYZ->DecreaseRef();
1735     if (pDblXYZ->isDeletable())
1736     {
1737         delete pDblXYZ;
1738     }
1739
1740     pDblNumfun->DecreaseRef();
1741     if (pDblNumfun->isDeletable())
1742     {
1743         delete pDblNumfun;
1744     }
1745
1746     out[0]->DecreaseRef();
1747     if (out[0]->isDouble() == false)
1748     {
1749         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1750         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
1751         FREE(pstrName);
1752         throw ast::InternalError(errorMsg);
1753     }
1754
1755     types::Double* pDblOut = out[0]->getAs<types::Double>();
1756     if (pDblOut->getSize() != *numfun)
1757     {
1758         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1759         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: Matrix of size %d expected.\n"), pstrName, 1, *numfun);
1760         FREE(pstrName);
1761         throw ast::InternalError(errorMsg);
1762     }
1763
1764     C2F(dcopy)(numfun, pDblOut->get(), &one, funvls, &one);
1765     if (out[0]->isDeletable())
1766     {
1767         delete out[0];
1768     }
1769 }
1770
1771 void DifferentialEquationFunctions::callFevalMacroF(int* nn, double* x1, double* x2, double* xres, int* itype)
1772 {
1773     char errorMsg[256];
1774     int one         = 1;
1775     int iRetCount   = 1;
1776
1777     typed_list in;
1778     typed_list out;
1779     types::optional_list opt;
1780     ast::ExecVisitor execFunc;
1781
1782     types::Double* pDblX = NULL;
1783     types::Double* pDblY = NULL;
1784
1785     // create input args
1786
1787     pDblX = new types::Double(*x1);
1788     pDblX->IncreaseRef();
1789     in.push_back(pDblX);
1790
1791     if (*nn == 2)
1792     {
1793         pDblY = new types::Double(*x2);
1794         pDblY->IncreaseRef();
1795         in.push_back(pDblY);
1796     }
1797
1798     for (int i = 0; i < (int)m_FArgs.size(); i++)
1799     {
1800         m_FArgs[i]->IncreaseRef();
1801         in.push_back(m_FArgs[i]);
1802     }
1803     try
1804     {
1805         // new std::wstring(L"") is delete in destructor of ast::CommentExp
1806         m_pCallFFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
1807     }
1808     catch (const ast::InternalError& ie)
1809     {
1810         for (int i = 0; i < (int)m_FArgs.size(); i++)
1811         {
1812             m_FArgs[i]->DecreaseRef();
1813         }
1814
1815         throw ie;
1816     }
1817
1818     for (int i = 0; i < (int)m_FArgs.size(); i++)
1819     {
1820         m_FArgs[i]->DecreaseRef();
1821     }
1822
1823     if (out.size() != iRetCount)
1824     {
1825         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1826         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
1827         FREE(pstrName);
1828         throw ast::InternalError(errorMsg);
1829     }
1830
1831     out[0]->IncreaseRef();
1832
1833     pDblX->DecreaseRef();
1834     if (pDblX->isDeletable())
1835     {
1836         delete pDblX;
1837     }
1838
1839     if (*nn == 2)
1840     {
1841         pDblY->DecreaseRef();
1842         if (pDblY->isDeletable())
1843         {
1844             delete pDblY;
1845         }
1846     }
1847
1848     out[0]->DecreaseRef();
1849     if (out[0]->isDouble() == false)
1850     {
1851         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1852         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
1853         FREE(pstrName);
1854         throw ast::InternalError(errorMsg);
1855
1856     }
1857
1858     types::Double* pDblOut = out[0]->getAs<types::Double>();
1859     if (pDblOut->getSize() != 1)
1860     {
1861         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
1862         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A Scalar expected.\n"), pstrName, 1);
1863         FREE(pstrName);
1864         throw ast::InternalError(errorMsg);
1865     }
1866
1867     if (pDblOut->isComplex())
1868     {
1869         *itype = 1;
1870         xres[0] = pDblOut->get(0);
1871         xres[1] = pDblOut->getImg(0);
1872     }
1873     else
1874     {
1875         *itype = 0;
1876         xres[0] = pDblOut->get(0);
1877     }
1878
1879     if (out[0]->isDeletable())
1880     {
1881         delete out[0];
1882     }
1883 }
1884
1885 void DifferentialEquationFunctions::callBvodeMacroGsub(int* i, double* z, double* g)
1886 {
1887     char errorMsg[256];
1888     int one         = 1;
1889     int iRetCount   = 1;
1890
1891     typed_list in;
1892     typed_list out;
1893     types::optional_list opt;
1894     ast::ExecVisitor execFunc;
1895
1896     types::Double* pDblI = NULL;
1897     types::Double* pDblZ = NULL;
1898
1899     pDblI = new types::Double(*i);
1900     pDblI->IncreaseRef();
1901     in.push_back(pDblI);
1902
1903     pDblZ = new types::Double(m_bvodeM, 1);
1904     pDblZ->set(z);
1905     pDblZ->IncreaseRef();
1906     in.push_back(pDblZ);
1907
1908
1909     for (int i = 0; i < (int)m_GsubArgs.size(); i++)
1910     {
1911         m_GsubArgs[i]->IncreaseRef();
1912         in.push_back(m_GsubArgs[i]);
1913     }
1914
1915     try
1916     {
1917         // new std::wstring(L"") is delete in destructor of ast::CommentExp
1918         m_pCallGsubFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
1919     }
1920     catch (const ast::InternalError& ie)
1921     {
1922         for (int i = 0; i < (int)m_GsubArgs.size(); i++)
1923         {
1924             m_GsubArgs[i]->DecreaseRef();
1925         }
1926
1927         throw ie;
1928     }
1929
1930     for (int i = 0; i < (int)m_GsubArgs.size(); i++)
1931     {
1932         m_GsubArgs[i]->DecreaseRef();
1933     }
1934
1935     if (out.size() != iRetCount)
1936     {
1937         char* pstrName = wide_string_to_UTF8(m_pCallGsubFunction->getName().c_str());
1938         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
1939         FREE(pstrName);
1940         throw ast::InternalError(errorMsg);
1941     }
1942
1943     out[0]->IncreaseRef();
1944
1945     pDblI->DecreaseRef();
1946     if (pDblI->isDeletable())
1947     {
1948         delete pDblI;
1949     }
1950
1951     pDblZ->DecreaseRef();
1952     if (pDblZ->isDeletable())
1953     {
1954         delete pDblZ;
1955     }
1956
1957     out[0]->DecreaseRef();
1958     if (out[0]->isDouble() == false)
1959     {
1960         char* pstrName = wide_string_to_UTF8(m_pCallGsubFunction->getName().c_str());
1961         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
1962         FREE(pstrName);
1963         throw ast::InternalError(errorMsg);
1964     }
1965
1966     types::Double* pDblOut = out[0]->getAs<types::Double>();
1967     if (pDblOut->getSize() != 1)
1968     {
1969         char* pstrName = wide_string_to_UTF8(m_pCallGsubFunction->getName().c_str());
1970         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A Scalar expected.\n"), pstrName, 1);
1971         FREE(pstrName);
1972         throw ast::InternalError(errorMsg);
1973     }
1974
1975     *g = pDblOut->get(0);
1976     if (out[0]->isDeletable())
1977     {
1978         delete out[0];
1979     }
1980 }
1981
1982 void DifferentialEquationFunctions::callBvodeMacroDgsub(int* i, double* z, double* g)
1983 {
1984     char errorMsg[256];
1985     int one         = 1;
1986     int iRetCount   = 1;
1987
1988     typed_list in;
1989     typed_list out;
1990     types::optional_list opt;
1991     ast::ExecVisitor execFunc;
1992
1993     types::Double* pDblI = NULL;
1994     types::Double* pDblZ = NULL;
1995
1996     pDblI = new types::Double(*i);
1997     pDblI->IncreaseRef();
1998     in.push_back(pDblI);
1999
2000     pDblZ = new types::Double(m_bvodeM, 1);
2001     pDblZ->set(z);
2002     pDblZ->IncreaseRef();
2003     in.push_back(pDblZ);
2004
2005     for (int i = 0; i < (int)m_DgsubArgs.size(); i++)
2006     {
2007         m_DgsubArgs[i]->IncreaseRef();
2008         in.push_back(m_DgsubArgs[i]);
2009     }
2010
2011     try
2012     {
2013         // new std::wstring(L"") is delete in destructor of ast::CommentExp
2014         m_pCallDgsubFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
2015     }
2016     catch (const ast::InternalError& ie)
2017     {
2018         for (int i = 0; i < (int)m_DgsubArgs.size(); i++)
2019         {
2020             m_DgsubArgs[i]->DecreaseRef();
2021         }
2022
2023         throw ie;
2024     }
2025
2026     for (int i = 0; i < (int)m_DgsubArgs.size(); i++)
2027     {
2028         m_DgsubArgs[i]->DecreaseRef();
2029     }
2030
2031     if (out.size() != iRetCount)
2032     {
2033         char* pstrName = wide_string_to_UTF8(m_pCallDgsubFunction->getName().c_str());
2034         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
2035         FREE(pstrName);
2036         throw ast::InternalError(errorMsg);
2037     }
2038
2039     out[0]->IncreaseRef();
2040
2041     pDblI->DecreaseRef();
2042     if (pDblI->isDeletable())
2043     {
2044         delete pDblI;
2045     }
2046
2047     pDblZ->DecreaseRef();
2048     if (pDblZ->isDeletable())
2049     {
2050         delete pDblZ;
2051     }
2052
2053     out[0]->DecreaseRef();
2054     if (out[0]->isDouble() == false)
2055     {
2056         char* pstrName = wide_string_to_UTF8(m_pCallDgsubFunction->getName().c_str());
2057         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
2058         FREE(pstrName);
2059         throw ast::InternalError(errorMsg);
2060     }
2061
2062     types::Double* pDblOut = out[0]->getAs<types::Double>();
2063     if (pDblOut->getSize() != m_bvodeM)
2064     {
2065         char* pstrName = wide_string_to_UTF8(m_pCallDgsubFunction->getName().c_str());
2066         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A Matrix of size %d expected.\n"), pstrName, 1, m_bvodeM);
2067         FREE(pstrName);
2068         throw ast::InternalError(errorMsg);
2069     }
2070
2071     C2F(dcopy)(&m_bvodeM, pDblOut->get(), &one, g, &one);
2072     if (out[0]->isDeletable())
2073     {
2074         delete out[0];
2075     }
2076 }
2077
2078 void DifferentialEquationFunctions::callBvodeMacroFsub(double* x, double* z, double* d)
2079 {
2080     char errorMsg[256];
2081     int one         = 1;
2082     int iRetCount   = 1;
2083
2084     typed_list in;
2085     typed_list out;
2086     types::optional_list opt;
2087     ast::ExecVisitor execFunc;
2088
2089     types::Double* pDblX = NULL;
2090     types::Double* pDblZ = NULL;
2091
2092     pDblX = new types::Double(*x);
2093     pDblX->IncreaseRef();
2094     in.push_back(pDblX);
2095
2096     pDblZ = new types::Double(m_bvodeM, 1);
2097     pDblZ->set(z);
2098     pDblZ->IncreaseRef();
2099     in.push_back(pDblZ);
2100
2101     for (int i = 0; i < (int)m_FsubArgs.size(); i++)
2102     {
2103         m_FsubArgs[i]->IncreaseRef();
2104         in.push_back(m_FsubArgs[i]);
2105     }
2106
2107     try
2108     {
2109         // new std::wstring(L"") is delete in destructor of ast::CommentExp
2110         m_pCallFsubFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
2111     }
2112     catch (const ast::InternalError& ie)
2113     {
2114         for (int i = 0; i < (int)m_FsubArgs.size(); i++)
2115         {
2116             m_FsubArgs[i]->DecreaseRef();
2117         }
2118
2119         throw ie;
2120     }
2121
2122     for (int i = 0; i < (int)m_FsubArgs.size(); i++)
2123     {
2124         m_FsubArgs[i]->DecreaseRef();
2125     }
2126
2127     if (out.size() != iRetCount)
2128     {
2129         char* pstrName = wide_string_to_UTF8(m_pCallFsubFunction->getName().c_str());
2130         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
2131         FREE(pstrName);
2132         throw ast::InternalError(errorMsg);
2133     }
2134
2135     out[0]->IncreaseRef();
2136
2137     pDblX->DecreaseRef();
2138     if (pDblX->isDeletable())
2139     {
2140         delete pDblX;
2141     }
2142
2143     pDblZ->DecreaseRef();
2144     if (pDblZ->isDeletable())
2145     {
2146         delete pDblZ;
2147     }
2148
2149     out[0]->DecreaseRef();
2150     if (out[0]->isDouble() == false)
2151     {
2152         char* pstrName = wide_string_to_UTF8(m_pCallFsubFunction->getName().c_str());
2153         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
2154         FREE(pstrName);
2155         throw ast::InternalError(errorMsg);
2156     }
2157
2158     types::Double* pDblOut = out[0]->getAs<types::Double>();
2159     if (pDblOut->getSize() != m_bvodeN)
2160     {
2161         char* pstrName = wide_string_to_UTF8(m_pCallFsubFunction->getName().c_str());
2162         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d expected.\n"), pstrName, 1, m_bvodeN);
2163         FREE(pstrName);
2164         throw ast::InternalError(errorMsg);
2165     }
2166
2167     C2F(dcopy)(&m_bvodeN, pDblOut->get(), &one, d, &one);
2168     if (out[0]->isDeletable())
2169     {
2170         delete out[0];
2171     }
2172 }
2173
2174 void DifferentialEquationFunctions::callBvodeMacroDfsub(double* x, double* z, double* d)
2175 {
2176     char errorMsg[256];
2177     int one         = 1;
2178     int iRetCount   = 1;
2179
2180     typed_list in;
2181     typed_list out;
2182     types::optional_list opt;
2183     ast::ExecVisitor execFunc;
2184
2185     types::Double* pDblX = NULL;
2186     types::Double* pDblZ = NULL;
2187
2188     pDblX = new types::Double(*x);
2189     pDblX->IncreaseRef();
2190     in.push_back(pDblX);
2191
2192     pDblZ = new types::Double(m_bvodeM, 1);
2193     pDblZ->set(z);
2194     pDblZ->IncreaseRef();
2195     in.push_back(pDblZ);
2196
2197     for (int i = 0; i < (int)m_DfsubArgs.size(); i++)
2198     {
2199         m_DfsubArgs[i]->IncreaseRef();
2200         in.push_back(m_DfsubArgs[i]);
2201     }
2202
2203     try
2204     {
2205         // new std::wstring(L"") is delete in destructor of ast::CommentExp
2206         m_pCallDfsubFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
2207     }
2208     catch (const ast::InternalError& ie)
2209     {
2210         for (int i = 0; i < (int)m_DfsubArgs.size(); i++)
2211         {
2212             m_DfsubArgs[i]->DecreaseRef();
2213         }
2214
2215         throw ie;
2216     }
2217
2218     for (int i = 0; i < (int)m_DfsubArgs.size(); i++)
2219     {
2220         m_DfsubArgs[i]->DecreaseRef();
2221     }
2222
2223     if (out.size() != iRetCount)
2224     {
2225         char* pstrName = wide_string_to_UTF8(m_pCallDfsubFunction->getName().c_str());
2226         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
2227         FREE(pstrName);
2228         throw ast::InternalError(errorMsg);
2229     }
2230
2231     out[0]->IncreaseRef();
2232
2233     pDblX->DecreaseRef();
2234     if (pDblX->isDeletable())
2235     {
2236         delete pDblX;
2237     }
2238
2239     pDblZ->DecreaseRef();
2240     if (pDblZ->isDeletable())
2241     {
2242         delete pDblZ;
2243     }
2244
2245     out[0]->DecreaseRef();
2246     if (out[0]->isDouble() == false)
2247     {
2248         char* pstrName = wide_string_to_UTF8(m_pCallDfsubFunction->getName().c_str());
2249         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
2250         FREE(pstrName);
2251         throw ast::InternalError(errorMsg);
2252     }
2253
2254     types::Double* pDblOut = out[0]->getAs<types::Double>();
2255     int size = m_bvodeN * m_bvodeM;
2256     if (pDblOut->getSize() != size)
2257     {
2258         char* pstrName = wide_string_to_UTF8(m_pCallDfsubFunction->getName().c_str());
2259         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d expected.\n"), pstrName, 1, size);
2260         FREE(pstrName);
2261         throw ast::InternalError(errorMsg);
2262     }
2263
2264     C2F(dcopy)(&size, pDblOut->get(), &one, d, &one);
2265     if (out[0]->isDeletable())
2266     {
2267         delete out[0];
2268     }
2269 }
2270
2271 void DifferentialEquationFunctions::callBvodeMacroGuess(double* x, double* z, double* d)
2272 {
2273     char errorMsg[256];
2274     int one         = 1;
2275     int iRetCount   = 2;
2276
2277     typed_list in;
2278     typed_list out;
2279     types::optional_list opt;
2280     ast::ExecVisitor execFunc;
2281
2282     types::Double* pDblX = NULL;
2283
2284     pDblX = new types::Double(*x);
2285     pDblX->IncreaseRef();
2286     in.push_back(pDblX);
2287
2288     for (int i = 0; i < (int)m_GuessArgs.size(); i++)
2289     {
2290         m_GuessArgs[i]->IncreaseRef();
2291         in.push_back(m_GuessArgs[i]);
2292     }
2293
2294     try
2295     {
2296         // new std::wstring(L"") is delete in destructor of ast::CommentExp
2297         m_pCallGuessFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
2298     }
2299     catch (const ast::InternalError& ie)
2300     {
2301         for (int i = 0; i < (int)m_GuessArgs.size(); i++)
2302         {
2303             m_GuessArgs[i]->DecreaseRef();
2304         }
2305
2306         throw ie;
2307     }
2308
2309     for (int i = 0; i < (int)m_GuessArgs.size(); i++)
2310     {
2311         m_GuessArgs[i]->DecreaseRef();
2312     }
2313
2314     if (out.size() != iRetCount)
2315     {
2316         char* pstrName = wide_string_to_UTF8(m_pCallGuessFunction->getName().c_str());
2317         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
2318         FREE(pstrName);
2319         throw ast::InternalError(errorMsg);
2320     }
2321
2322     out[0]->IncreaseRef();
2323     out[1]->IncreaseRef();
2324
2325     pDblX->DecreaseRef();
2326     if (pDblX->isDeletable())
2327     {
2328         delete pDblX;
2329     }
2330
2331     out[0]->DecreaseRef();
2332     if (out[0]->isDouble() == false)
2333     {
2334         char* pstrName = wide_string_to_UTF8(m_pCallGuessFunction->getName().c_str());
2335         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
2336         FREE(pstrName);
2337         throw ast::InternalError(errorMsg);
2338     }
2339
2340     out[1]->DecreaseRef();
2341     if (out[1]->isDouble() == false)
2342     {
2343         char* pstrName = wide_string_to_UTF8(m_pCallGuessFunction->getName().c_str());
2344         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 2);
2345         FREE(pstrName);
2346         throw ast::InternalError(errorMsg);
2347     }
2348
2349     types::Double* pDblOutZ = out[0]->getAs<types::Double>();
2350     if (pDblOutZ->getSize() != m_bvodeM)
2351     {
2352         char* pstrName = wide_string_to_UTF8(m_pCallGuessFunction->getName().c_str());
2353         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d expected.\n"), pstrName, 1, m_bvodeM);
2354         FREE(pstrName);
2355         throw ast::InternalError(errorMsg);
2356     }
2357
2358     types::Double* pDblOutD = out[1]->getAs<types::Double>();
2359     if (pDblOutD->getSize() != m_bvodeN)
2360     {
2361         char* pstrName = wide_string_to_UTF8(m_pCallGuessFunction->getName().c_str());
2362         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d expected.\n"), pstrName, 1, m_bvodeN);
2363         FREE(pstrName);
2364         throw ast::InternalError(errorMsg);
2365     }
2366
2367     C2F(dcopy)(&m_bvodeM, pDblOutZ->get(), &one, z, &one);
2368     C2F(dcopy)(&m_bvodeN, pDblOutD->get(), &one, d, &one);
2369     if (out[0]->isDeletable())
2370     {
2371         delete out[0];
2372     }
2373
2374     if (out[1]->isDeletable())
2375     {
2376         delete out[1];
2377     }
2378 }
2379
2380 void DifferentialEquationFunctions::callImplMacroF(int* neq, double* t, double* y, double*s, double* r, int* ires)
2381 {
2382     char errorMsg[256];
2383     int one         = 1;
2384     int iRetCount   = 1;
2385
2386     *ires = 2;
2387
2388     typed_list in;
2389     typed_list out;
2390     types::optional_list opt;
2391     ast::ExecVisitor execFunc;
2392
2393     types::Double* pDblT = new types::Double(*t);
2394     pDblT->IncreaseRef();
2395     in.push_back(pDblT);
2396
2397     types::Double* pDblY = new types::Double(*neq, 1);
2398     pDblY->set(y);
2399     pDblY->IncreaseRef();
2400     in.push_back(pDblY);
2401
2402     types::Double* pDblS = new types::Double(*neq, 1);
2403     pDblS->set(s);
2404     pDblS->IncreaseRef();
2405     in.push_back(pDblS);
2406
2407     for (int i = 0; i < (int)m_FArgs.size(); i++)
2408     {
2409         m_FArgs[i]->IncreaseRef();
2410         in.push_back(m_FArgs[i]);
2411     }
2412
2413     try
2414     {
2415         // new std::wstring(L"") is delete in destructor of ast::CommentExp
2416         m_pCallFFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
2417     }
2418     catch (const ast::InternalError& ie)
2419     {
2420         for (int i = 0; i < (int)m_FArgs.size(); i++)
2421         {
2422             m_FArgs[i]->DecreaseRef();
2423         }
2424
2425         throw ie;
2426     }
2427
2428     if (out.size() != iRetCount)
2429     {
2430         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
2431         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
2432         FREE(pstrName);
2433         throw ast::InternalError(errorMsg);
2434     }
2435
2436     out[0]->IncreaseRef();
2437
2438     pDblT->DecreaseRef();
2439     if (pDblT->isDeletable())
2440     {
2441         delete pDblT;
2442     }
2443
2444     pDblY->DecreaseRef();
2445     if (pDblY->isDeletable())
2446     {
2447         delete pDblY;
2448     }
2449
2450     pDblS->DecreaseRef();
2451     if (pDblS->isDeletable())
2452     {
2453         delete pDblS;
2454     }
2455
2456     out[0]->DecreaseRef();
2457     if (out[0]->isDouble() == false)
2458     {
2459         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
2460         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Matrix expected.\n"), pstrName, 1);
2461         FREE(pstrName);
2462         throw ast::InternalError(errorMsg);
2463     }
2464
2465     types::Double* pDblOutR = out[0]->getAs<types::Double>();
2466     if (pDblOutR->getSize() != *neq)
2467     {
2468         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
2469         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A Matrix of size %d expected.\n"), pstrName, 1, *neq);
2470         FREE(pstrName);
2471         throw ast::InternalError(errorMsg);
2472     }
2473
2474     C2F(dcopy)(neq, pDblOutR->get(), &one, r, &one);
2475     *ires = 1;
2476     if (out[0]->isDeletable())
2477     {
2478         delete out[0];
2479     }
2480 }
2481
2482 void DifferentialEquationFunctions::callImplMacroG(int* neq, double* t, double* y, double* ml, double* mu, double* p, int* nrowp)
2483 {
2484     char errorMsg[256];
2485     int one         = 1;
2486     int iRetCount   = 1;
2487
2488     typed_list in;
2489     typed_list out;
2490     types::optional_list opt;
2491     ast::ExecVisitor execFunc;
2492
2493     types::Double* pDblT = new types::Double(*t);
2494     pDblT->IncreaseRef();
2495     in.push_back(pDblT);
2496
2497     types::Double* pDblY = new types::Double(*neq, 1);
2498     pDblY->set(y);
2499     pDblY->IncreaseRef();
2500     in.push_back(pDblY);
2501
2502     types::Double* pDblP = new types::Double(*nrowp, *neq);
2503     pDblP->set(p);
2504     pDblP->IncreaseRef();
2505     in.push_back(pDblP);
2506
2507     for (int i = 0; i < (int)m_odeGArgs.size(); i++)
2508     {
2509         m_odeGArgs[i]->IncreaseRef();
2510         in.push_back(m_odeGArgs[i]);
2511     }
2512
2513     try
2514     {
2515         // new std::wstring(L"") is delete in destructor of ast::CommentExp
2516         m_pCallGFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
2517     }
2518     catch (const ast::InternalError& ie)
2519     {
2520         for (int i = 0; i < (int)m_odeGArgs.size(); i++)
2521         {
2522             m_odeGArgs[i]->DecreaseRef();
2523         }
2524
2525         throw ie;
2526     }
2527
2528     for (int i = 0; i < (int)m_odeGArgs.size(); i++)
2529     {
2530         m_odeGArgs[i]->DecreaseRef();
2531     }
2532
2533     if (out.size() != iRetCount)
2534     {
2535         char* pstrName = wide_string_to_UTF8(m_pCallGFunction->getName().c_str());
2536         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
2537         FREE(pstrName);
2538         throw ast::InternalError(errorMsg);
2539     }
2540
2541     out[0]->IncreaseRef();
2542
2543     pDblT->DecreaseRef();
2544     if (pDblT->isDeletable())
2545     {
2546         delete pDblT;
2547     }
2548
2549     pDblY->DecreaseRef();
2550     if (pDblY->isDeletable())
2551     {
2552         delete pDblY;
2553     }
2554
2555     out[0]->DecreaseRef();
2556     if (out[0]->isDouble() == false)
2557     {
2558         char* pstrName = wide_string_to_UTF8(m_pCallGFunction->getName().c_str());
2559         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
2560         FREE(pstrName);
2561         throw ast::InternalError(errorMsg);
2562     }
2563
2564     types::Double* pDblOutP = out[0]->getAs<types::Double>();
2565     if (pDblOutP->getCols() != *neq || pDblOutP->getRows() != *nrowp)
2566     {
2567         char* pstrName = wide_string_to_UTF8(m_pCallGFunction->getName().c_str());
2568         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d x %d expected.\n"), pstrName, 1, *neq, *nrowp);
2569         FREE(pstrName);
2570         throw ast::InternalError(errorMsg);
2571     }
2572
2573     int size = *neq **nrowp;
2574     C2F(dcopy)(&size, pDblOutP->get(), &one, p, &one);
2575     if (out[0]->isDeletable())
2576     {
2577         delete out[0];
2578     }
2579 }
2580
2581 void DifferentialEquationFunctions::callImplMacroJac(int* neq, double* t, double* y, double* s, double* ml, double* mu, double* p, int* nrowp)
2582 {
2583     char errorMsg[256];
2584     int one         = 1;
2585     int iRetCount   = 1;
2586
2587     typed_list in;
2588     typed_list out;
2589     types::optional_list opt;
2590     ast::ExecVisitor execFunc;
2591
2592     types::Double* pDblT = new types::Double(*t);
2593     pDblT->IncreaseRef();
2594     in.push_back(pDblT);
2595
2596     types::Double* pDblY = new types::Double(*neq, 1);
2597     pDblY->set(y);
2598     pDblY->IncreaseRef();
2599     in.push_back(pDblY);
2600
2601     types::Double* pDblS = new types::Double(*neq, 1);
2602     pDblS->set(s);
2603     pDblS->IncreaseRef();
2604     in.push_back(pDblS);
2605
2606     for (int i = 0; i < (int)m_JacArgs.size(); i++)
2607     {
2608         m_JacArgs[i]->IncreaseRef();
2609         in.push_back(m_JacArgs[i]);
2610     }
2611
2612     try
2613     {
2614         // new std::wstring(L"") is delete in destructor of ast::CommentExp
2615         m_pCallJacFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
2616     }
2617     catch (const ast::InternalError& ie)
2618     {
2619         for (int i = 0; i < (int)m_JacArgs.size(); i++)
2620         {
2621             m_JacArgs[i]->DecreaseRef();
2622         }
2623
2624         throw ie;
2625     }
2626
2627     for (int i = 0; i < (int)m_JacArgs.size(); i++)
2628     {
2629         m_JacArgs[i]->DecreaseRef();
2630     }
2631
2632     if (out.size() != iRetCount)
2633     {
2634         char* pstrName = wide_string_to_UTF8(m_pCallJacFunction->getName().c_str());
2635         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
2636         FREE(pstrName);
2637         throw ast::InternalError(errorMsg);
2638     }
2639
2640     out[0]->IncreaseRef();
2641
2642     pDblT->DecreaseRef();
2643     if (pDblT->isDeletable())
2644     {
2645         delete pDblT;
2646     }
2647
2648     pDblY->DecreaseRef();
2649     if (pDblY->isDeletable())
2650     {
2651         delete pDblY;
2652     }
2653
2654     pDblS->DecreaseRef();
2655     if (pDblS->isDeletable())
2656     {
2657         delete pDblS;
2658     }
2659
2660     out[0]->DecreaseRef();
2661     if (out[0]->isDouble() == false)
2662     {
2663         char* pstrName = wide_string_to_UTF8(m_pCallJacFunction->getName().c_str());
2664         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
2665         FREE(pstrName);
2666         throw ast::InternalError(errorMsg);
2667     }
2668
2669     types::Double* pDblOutP = out[0]->getAs<types::Double>();
2670     if (pDblOutP->getCols() != *neq || pDblOutP->getRows() != *nrowp)
2671     {
2672         char* pstrName = wide_string_to_UTF8(m_pCallJacFunction->getName().c_str());
2673         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d x %d expected.\n"), pstrName, 1, *neq, *nrowp);
2674         FREE(pstrName);
2675         throw ast::InternalError(errorMsg);
2676     }
2677
2678     int size = *neq **nrowp;
2679     C2F(dcopy)(&size, pDblOutP->get(), &one, p, &one);
2680     if (out[0]->isDeletable())
2681     {
2682         delete out[0];
2683     }
2684 }
2685
2686 void DifferentialEquationFunctions::callDasslMacroF(double* t, double* y, double* ydot, double* delta, int* ires, double* rpar, int* ipar)
2687 {
2688     char errorMsg[256];
2689     int one         = 1;
2690     int iRetCount   = 2;
2691
2692     typed_list in;
2693     typed_list out;
2694     types::optional_list opt;
2695     ast::ExecVisitor execFunc;
2696
2697     types::Double* pDblT = new types::Double(*t);
2698     pDblT->IncreaseRef();
2699     in.push_back(pDblT);
2700
2701     types::Double* pDblY = new types::Double(m_odeYRows, 1);
2702     pDblY->set(y);
2703     pDblY->IncreaseRef();
2704     in.push_back(pDblY);
2705
2706     types::Double* pDblYdot = new types::Double(m_odeYRows, 1);
2707     pDblYdot->set(ydot);
2708     pDblYdot->IncreaseRef();
2709     in.push_back(pDblYdot);
2710
2711     for (int i = 0; i < (int)m_FArgs.size(); i++)
2712     {
2713         m_FArgs[i]->IncreaseRef();
2714         in.push_back(m_FArgs[i]);
2715     }
2716
2717     try
2718     {
2719         // new std::wstring(L"") is delete in destructor of ast::CommentExp
2720         m_pCallFFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
2721     }
2722     catch (const ast::InternalError& ie)
2723     {
2724         for (int i = 0; i < (int)m_FArgs.size(); i++)
2725         {
2726             m_FArgs[i]->DecreaseRef();
2727         }
2728
2729         throw ie;
2730     }
2731
2732     for (int i = 0; i < (int)m_FArgs.size(); i++)
2733     {
2734         m_FArgs[i]->DecreaseRef();
2735     }
2736
2737     if (out.size() != iRetCount)
2738     {
2739         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
2740         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
2741         FREE(pstrName);
2742         throw ast::InternalError(errorMsg);
2743     }
2744
2745     out[0]->IncreaseRef();
2746     out[1]->IncreaseRef();
2747
2748     pDblT->DecreaseRef();
2749     if (pDblT->isDeletable())
2750     {
2751         delete pDblT;
2752     }
2753
2754     pDblY->DecreaseRef();
2755     if (pDblY->isDeletable())
2756     {
2757         delete pDblY;
2758     }
2759
2760     pDblYdot->DecreaseRef();
2761     if (pDblYdot->isDeletable())
2762     {
2763         delete pDblYdot;
2764     }
2765
2766     out[0]->DecreaseRef();
2767     if (out[0]->isDouble() == false)
2768     {
2769         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
2770         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
2771         FREE(pstrName);
2772         throw ast::InternalError(errorMsg);
2773     }
2774
2775     out[1]->DecreaseRef();
2776     if (out[1]->isDouble() == false)
2777     {
2778         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
2779         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 2);
2780         FREE(pstrName);
2781         throw ast::InternalError(errorMsg);
2782     }
2783
2784     types::Double* pDblOutDelta = out[0]->getAs<types::Double>();
2785     if (pDblOutDelta->getSize() != m_odeYRows)
2786     {
2787         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
2788         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d expected.\n"), pstrName, 1, m_odeYRows);
2789         FREE(pstrName);
2790         throw ast::InternalError(errorMsg);
2791     }
2792
2793     types::Double* pDblOutIres = out[1]->getAs<types::Double>();
2794     if (pDblOutIres->getSize() != 1)
2795     {
2796         char* pstrName = wide_string_to_UTF8(m_pCallFFunction->getName().c_str());
2797         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A Scalar expected.\n"), pstrName, 2);
2798         FREE(pstrName);
2799         throw ast::InternalError(errorMsg);
2800     }
2801
2802     C2F(dcopy)(&m_odeYRows, pDblOutDelta->get(), &one, delta, &one);
2803     *ires = (int)pDblOutIres->get(0);
2804
2805     if (out[0]->isDeletable())
2806     {
2807         delete out[0];
2808     }
2809
2810     if (out[1]->isDeletable())
2811     {
2812         delete out[1];
2813     }
2814 }
2815
2816 void DifferentialEquationFunctions::callDasslMacroJac(double* t, double* y, double* ydot, double* pd, double* cj, double* rpar, int* ipar)
2817 {
2818     char errorMsg[256];
2819     int one         = 1;
2820     int iRetCount   = 1;
2821
2822     typed_list in;
2823     typed_list out;
2824     types::optional_list opt;
2825     ast::ExecVisitor execFunc;
2826
2827     types::Double* pDblT = new types::Double(*t);
2828     pDblT->IncreaseRef();
2829     in.push_back(pDblT);
2830
2831     types::Double* pDblY = new types::Double(m_odeYRows, 1);
2832     pDblY->set(y);
2833     pDblY->IncreaseRef();
2834     in.push_back(pDblY);
2835
2836     types::Double* pDblYdot = new types::Double(m_odeYRows, 1);
2837     pDblYdot->set(ydot);
2838     pDblYdot->IncreaseRef();
2839     in.push_back(pDblYdot);
2840
2841     types::Double* pDblCj = new types::Double(*cj);
2842     pDblCj->IncreaseRef();
2843     in.push_back(pDblCj);
2844
2845     for (int i = 0; i < (int)m_JacArgs.size(); i++)
2846     {
2847         m_JacArgs[i]->IncreaseRef();
2848         in.push_back(m_JacArgs[i]);
2849     }
2850
2851     try
2852     {
2853         // new std::wstring(L"") is delete in destructor of ast::CommentExp
2854         m_pCallJacFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
2855     }
2856     catch (const ast::InternalError& ie)
2857     {
2858         for (int i = 0; i < (int)m_JacArgs.size(); i++)
2859         {
2860             m_JacArgs[i]->DecreaseRef();
2861         }
2862
2863         throw ie;
2864     }
2865
2866     for (int i = 0; i < (int)m_JacArgs.size(); i++)
2867     {
2868         m_JacArgs[i]->DecreaseRef();
2869     }
2870
2871     if (out.size() != iRetCount)
2872     {
2873         char* pstrName = wide_string_to_UTF8(m_pCallJacFunction->getName().c_str());
2874         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
2875         FREE(pstrName);
2876         throw ast::InternalError(errorMsg);
2877     }
2878
2879     out[0]->IncreaseRef();
2880
2881     pDblT->DecreaseRef();
2882     if (pDblT->isDeletable())
2883     {
2884         delete pDblT;
2885     }
2886
2887     pDblY->DecreaseRef();
2888     if (pDblY->isDeletable())
2889     {
2890         delete pDblY;
2891     }
2892
2893     pDblYdot->DecreaseRef();
2894     if (pDblYdot->isDeletable())
2895     {
2896         delete pDblYdot;
2897     }
2898
2899     pDblCj->DecreaseRef();
2900     if (pDblCj->isDeletable())
2901     {
2902         delete pDblCj;
2903     }
2904
2905     out[0]->DecreaseRef();
2906     if (out[0]->isDouble() == false)
2907     {
2908         char* pstrName = wide_string_to_UTF8(m_pCallJacFunction->getName().c_str());
2909         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
2910         FREE(pstrName);
2911         throw ast::InternalError(errorMsg);
2912     }
2913
2914     types::Double* pDblOutPd = out[0]->getAs<types::Double>();
2915     if ( (pDblOutPd->getCols() != m_odeYRows) ||
2916             (!m_bandedJac && pDblOutPd->getRows() != m_odeYRows) ||
2917             (m_bandedJac && pDblOutPd->getRows() != (2 * m_ml + m_mu + 1)))
2918     {
2919         char* pstrName = wide_string_to_UTF8(m_pCallJacFunction->getName().c_str());
2920         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d x %d expected.\n"), pstrName, 1, m_odeYRows, (2 * m_ml + m_mu + 1));
2921         FREE(pstrName);
2922         throw ast::InternalError(errorMsg);
2923     }
2924
2925     int size = pDblOutPd->getSize();
2926     C2F(dcopy)(&size, pDblOutPd->get(), &one, pd, &one);
2927     if (out[0]->isDeletable())
2928     {
2929         delete out[0];
2930     }
2931 }
2932
2933 void DifferentialEquationFunctions::callDasrtMacroG(int* ny, double* t, double* y, int* ng, double* gout, double* rpar, int* ipar)
2934 {
2935     char errorMsg[256];
2936     int one         = 1;
2937     int iRetCount   = 1;
2938
2939     typed_list in;
2940     typed_list out;
2941     types::optional_list opt;
2942     ast::ExecVisitor execFunc;
2943
2944     types::Double* pDblT = new types::Double(*t);
2945     pDblT->IncreaseRef();
2946     in.push_back(pDblT);
2947
2948     types::Double* pDblY = new types::Double(*ny, 1);
2949     pDblY->set(y);
2950     pDblY->IncreaseRef();
2951     in.push_back(pDblY);
2952
2953     for (int i = 0; i < (int)m_odeGArgs.size(); i++)
2954     {
2955         m_odeGArgs[i]->IncreaseRef();
2956         in.push_back(m_odeGArgs[i]);
2957     }
2958
2959     try
2960     {
2961         // new std::wstring(L"") is delete in destructor of ast::CommentExp
2962         m_pCallGFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
2963     }
2964     catch (const ast::InternalError& ie)
2965     {
2966         for (int i = 0; i < (int)m_odeGArgs.size(); i++)
2967         {
2968             m_odeGArgs[i]->DecreaseRef();
2969         }
2970
2971         throw ie;
2972     }
2973
2974     for (int i = 0; i < (int)m_odeGArgs.size(); i++)
2975     {
2976         m_odeGArgs[i]->DecreaseRef();
2977     }
2978
2979     if (out.size() != iRetCount)
2980     {
2981         char* pstrName = wide_string_to_UTF8(m_pCallGFunction->getName().c_str());
2982         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
2983         FREE(pstrName);
2984         throw ast::InternalError(errorMsg);
2985     }
2986
2987     out[0]->IncreaseRef();
2988
2989     pDblT->DecreaseRef();
2990     if (pDblT->isDeletable())
2991     {
2992         delete pDblT;
2993     }
2994
2995     pDblY->DecreaseRef();
2996     if (pDblY->isDeletable())
2997     {
2998         delete pDblY;
2999     }
3000
3001     out[0]->DecreaseRef();
3002     if (out[0]->isDouble() == false)
3003     {
3004         char* pstrName = wide_string_to_UTF8(m_pCallGFunction->getName().c_str());
3005         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
3006         FREE(pstrName);
3007         throw ast::InternalError(errorMsg);
3008     }
3009
3010     types::Double* pDblOutGout = out[0]->getAs<types::Double>();
3011     if (pDblOutGout->getSize() != *ng)
3012     {
3013         char* pstrName = wide_string_to_UTF8(m_pCallGFunction->getName().c_str());
3014         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d expected.\n"), pstrName, 1, *ng);
3015         FREE(pstrName);
3016         throw ast::InternalError(errorMsg);
3017     }
3018
3019     C2F(dcopy)(ng, pDblOutGout->get(), &one, gout, &one);
3020     if (out[0]->isDeletable())
3021     {
3022         delete out[0];
3023     }
3024 }
3025
3026 void DifferentialEquationFunctions::callDaskrMacroPjac(double* res, int* ires, int* neq, double* t, double* y, double* ydot,
3027         double* rewt, double* savr, double* wk, double* h, double* cj,
3028         double* wp, int* iwp, int* ier, double* rpar, int* ipar)
3029 {
3030     // macro : [R, iR, ier] = psol(neq, t, y, ydot, h, cj, rewt, savr)
3031     char errorMsg[256];
3032     int one         = 1;
3033     int iRetCount   = 3;
3034
3035     typed_list in;
3036     typed_list out;
3037     types::optional_list opt;
3038     ast::ExecVisitor execFunc;
3039
3040     types::Double* pDblNeq = new types::Double((double)(*neq));
3041     pDblNeq->IncreaseRef();
3042     in.push_back(pDblNeq);
3043
3044     types::Double* pDblT = new types::Double(*t);
3045     pDblT->IncreaseRef();
3046     in.push_back(pDblT);
3047
3048     types::Double* pDblY = new types::Double(m_odeYRows, 1);
3049     pDblY->set(y);
3050     pDblY->IncreaseRef();
3051     in.push_back(pDblY);
3052
3053     types::Double* pDblYdot = new types::Double(m_odeYRows, 1);
3054     pDblYdot->set(ydot);
3055     pDblYdot->IncreaseRef();
3056     in.push_back(pDblYdot);
3057
3058     types::Double* pDblH = new types::Double(*h);
3059     pDblH->IncreaseRef();
3060     in.push_back(pDblH);
3061
3062     types::Double* pDblCj = new types::Double(*cj);
3063     pDblCj->IncreaseRef();
3064     in.push_back(pDblCj);
3065
3066     types::Double* pDblRewt = new types::Double(m_odeYRows, 1);
3067     pDblRewt->set(rewt);
3068     pDblRewt->IncreaseRef();
3069     in.push_back(pDblRewt);
3070
3071     types::Double* pDblSavr = new types::Double(m_odeYRows, 1);
3072     pDblSavr->set(savr);
3073     pDblSavr->IncreaseRef();
3074     in.push_back(pDblSavr);
3075
3076     for (int i = 0; i < (int)m_pJacArgs.size(); i++)
3077     {
3078         m_pJacArgs[i]->IncreaseRef();
3079         in.push_back(m_pJacArgs[i]);
3080     }
3081
3082     try
3083     {
3084         // new std::wstring(L"") is delete in destructor of ast::CommentExp
3085         m_pCallPjacFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
3086     }
3087     catch (const ast::InternalError& ie)
3088     {
3089         for (int i = 0; i < (int)m_pJacArgs.size(); i++)
3090         {
3091             m_pJacArgs[i]->DecreaseRef();
3092         }
3093
3094         throw ie;
3095     }
3096
3097     for (int i = 0; i < (int)m_pJacArgs.size(); i++)
3098     {
3099         m_pJacArgs[i]->DecreaseRef();
3100     }
3101
3102     if (out.size() != iRetCount)
3103     {
3104         char* pstrName = wide_string_to_UTF8(m_pCallPjacFunction->getName().c_str());
3105         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
3106         FREE(pstrName);
3107         throw ast::InternalError(errorMsg);
3108     }
3109
3110     out[0]->IncreaseRef();
3111     out[1]->IncreaseRef();
3112     out[2]->IncreaseRef();
3113
3114     pDblNeq->DecreaseRef();
3115     if (pDblNeq->isDeletable())
3116     {
3117         delete pDblNeq;
3118     }
3119
3120     pDblT->DecreaseRef();
3121     if (pDblT->isDeletable())
3122     {
3123         delete pDblT;
3124     }
3125
3126     pDblY->DecreaseRef();
3127     if (pDblY->isDeletable())
3128     {
3129         delete pDblY;
3130     }
3131
3132     pDblYdot->DecreaseRef();
3133     if (pDblYdot->isDeletable())
3134     {
3135         delete pDblYdot;
3136     }
3137
3138     pDblH->DecreaseRef();
3139     if (pDblH->isDeletable())
3140     {
3141         delete pDblH;
3142     }
3143
3144     pDblCj->DecreaseRef();
3145     if (pDblCj->isDeletable())
3146     {
3147         delete pDblCj;
3148     }
3149
3150     pDblRewt->DecreaseRef();
3151     if (pDblRewt->isDeletable())
3152     {
3153         delete pDblRewt;
3154     }
3155
3156     pDblSavr->DecreaseRef();
3157     if (pDblSavr->isDeletable())
3158     {
3159         delete pDblSavr;
3160     }
3161
3162     // check type of output arguments
3163     if (out[0]->isDouble() == false)
3164     {
3165         char* pstrName = wide_string_to_UTF8(m_pCallPjacFunction->getName().c_str());
3166         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
3167         FREE(pstrName);
3168         throw ast::InternalError(errorMsg);
3169     }
3170
3171     if (out[1]->isDouble() == false)
3172     {
3173         char* pstrName = wide_string_to_UTF8(m_pCallPjacFunction->getName().c_str());
3174         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 2);
3175         FREE(pstrName);
3176         throw ast::InternalError(errorMsg);
3177     }
3178
3179     if (out[2]->isDouble() == false)
3180     {
3181         char* pstrName = wide_string_to_UTF8(m_pCallPjacFunction->getName().c_str());
3182         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 3);
3183         FREE(pstrName);
3184         throw ast::InternalError(errorMsg);
3185     }
3186
3187     //  return [R, iR, ier]
3188     types::Double* pDblOutWp  = out[0]->getAs<types::Double>();
3189     types::Double* pDblOutIwp = out[1]->getAs<types::Double>();
3190     types::Double* pDblOutIer = out[2]->getAs<types::Double>();
3191
3192     // check size of output argument
3193     if (pDblOutWp->getSize() != *neq **neq)
3194     {
3195         char* pstrName = wide_string_to_UTF8(m_pCallPjacFunction->getName().c_str());
3196         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d expected.\n"), pstrName, 1, *neq **neq);
3197         FREE(pstrName);
3198         throw ast::InternalError(errorMsg);
3199     }
3200
3201     if (pDblOutIwp->getSize() != 2 * *neq **neq)
3202     {
3203         char* pstrName = wide_string_to_UTF8(m_pCallPjacFunction->getName().c_str());
3204         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d expected.\n"), pstrName, 2, 2 * *neq **neq);
3205         FREE(pstrName);
3206         throw ast::InternalError(errorMsg);
3207     }
3208
3209     if (pDblOutIer->isScalar() == false)
3210     {
3211         char* pstrName = wide_string_to_UTF8(m_pCallPjacFunction->getName().c_str());
3212         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A Scalar expected.\n"), pstrName, 3);
3213         FREE(pstrName);
3214         throw ast::InternalError(errorMsg);
3215     }
3216
3217     // copy output macro results in output variables
3218     int size = pDblOutWp->getSize();
3219     C2F(dcopy)(&size, pDblOutWp->get(), &one, wp, &one);
3220
3221     double* pdblIwp = pDblOutIwp->get();
3222     for (int i = 0; i < pDblOutIwp->getSize(); i++)
3223     {
3224         iwp[i] = (int)pdblIwp[i];
3225     }
3226
3227     *ier = (int)(pDblOutIer->get(0));
3228
3229     // delete output macro result
3230     out[0]->DecreaseRef();
3231     if (out[0]->isDeletable())
3232     {
3233         delete out[0];
3234     }
3235
3236     out[1]->DecreaseRef();
3237     if (out[1]->isDeletable())
3238     {
3239         delete out[1];
3240     }
3241
3242     out[2]->DecreaseRef();
3243     if (out[2]->isDeletable())
3244     {
3245         delete out[2];
3246     }
3247 }
3248
3249 void DifferentialEquationFunctions::callDaskrMacroPsol(int* neq, double* t, double* y, double* ydot, double* savr, double* wk,
3250         double* cj, double* wght, double* wp, int* iwp, double* b, double* eplin,
3251         int* ier, double* rpar, int* ipar)
3252 {
3253     // macro : [b, ier] = psol(R, iR, b)
3254     char errorMsg[256];
3255     int one         = 1;
3256     int iRetCount   = 2;
3257
3258     typed_list in;
3259     typed_list out;
3260     types::optional_list opt;
3261     ast::ExecVisitor execFunc;
3262
3263     // input arguments psol(R, iR, b)
3264     types::Double* pDblR = new types::Double(*neq **neq, 1);
3265     pDblR->set(wp);
3266     pDblR->IncreaseRef();
3267     in.push_back(pDblR);
3268
3269     types::Double* pDblIR = new types::Double(*neq **neq, 2);
3270     double* pdblIR = pDblIR->get();
3271     for (int i = 0; i < pDblIR->getSize(); i++)
3272     {
3273         pdblIR[i] = (double)iwp[i];
3274     }
3275     pDblIR->IncreaseRef();
3276     in.push_back(pDblIR);
3277
3278     types::Double* pDblB = new types::Double(*neq, 1);
3279     pDblB->set(b);
3280     pDblB->IncreaseRef();
3281     in.push_back(pDblB);
3282
3283     // optional arguments
3284     for (int i = 0; i < (int)m_pSolArgs.size(); i++)
3285     {
3286         m_pSolArgs[i]->IncreaseRef();
3287         in.push_back(m_pSolArgs[i]);
3288     }
3289
3290     try
3291     {
3292         // new std::wstring(L"") is delete in destructor of ast::CommentExp
3293         m_pCallPsolFunction->invoke(in, opt, iRetCount, out, execFunc, ast::CommentExp(Location(), new std::wstring(L"")));
3294     }
3295     catch (const ast::InternalError& ie)
3296     {
3297         for (int i = 0; i < (int)m_pSolArgs.size(); i++)
3298         {
3299             m_pSolArgs[i]->DecreaseRef();
3300         }
3301
3302         throw ie;
3303     }
3304
3305     for (int i = 0; i < (int)m_pSolArgs.size(); i++)
3306     {
3307         m_pSolArgs[i]->DecreaseRef();
3308     }
3309
3310     // get output
3311     if (out.size() != iRetCount)
3312     {
3313         char* pstrName = wide_string_to_UTF8(m_pCallPsolFunction->getName().c_str());
3314         sprintf(errorMsg, _("%s: Wrong number of output argument(s): %d expected.\n"), pstrName, iRetCount);
3315         FREE(pstrName);
3316         throw ast::InternalError(errorMsg);
3317     }
3318
3319     out[0]->IncreaseRef();
3320     out[1]->IncreaseRef();
3321
3322     // free input arguments
3323     pDblR->DecreaseRef();
3324     if (pDblR->isDeletable())
3325     {
3326         delete pDblR;
3327     }
3328
3329     pDblIR->DecreaseRef();
3330     if (pDblIR->isDeletable())
3331     {
3332         delete pDblIR;
3333     }
3334
3335     pDblB->DecreaseRef();
3336     if (pDblB->isDeletable())
3337     {
3338         delete pDblB;
3339     }
3340
3341     // check output result
3342     if (out[0]->isDouble() == false)
3343     {
3344         char* pstrName = wide_string_to_UTF8(m_pCallPsolFunction->getName().c_str());
3345         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 1);
3346         FREE(pstrName);
3347         throw ast::InternalError(errorMsg);
3348     }
3349
3350     if (out[1]->isDouble() == false)
3351     {
3352         char* pstrName = wide_string_to_UTF8(m_pCallPsolFunction->getName().c_str());
3353         sprintf(errorMsg, _("%s: Wrong type for output argument #%d: Real matrix expected.\n"), pstrName, 2);
3354         FREE(pstrName);
3355         throw ast::InternalError(errorMsg);
3356     }
3357
3358     // return arguments [b, ier] = psol()
3359     types::Double* pDblOutB  = out[0]->getAs<types::Double>();
3360     if (pDblOutB->getSize() != *neq) // size of b is neq
3361     {
3362         char* pstrName = wide_string_to_UTF8(m_pCallPsolFunction->getName().c_str());
3363         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A matrix of size %d expected.\n"), pstrName, 1, *neq);
3364         FREE(pstrName);
3365         throw ast::InternalError(errorMsg);
3366     }
3367
3368     // get scalar ier
3369     types::Double* pDblOutIer = out[1]->getAs<types::Double>();
3370     if (pDblOutIer->isScalar() == false)
3371     {
3372         char* pstrName = wide_string_to_UTF8(m_pCallPsolFunction->getName().c_str());
3373         sprintf(errorMsg, _("%s: Wrong size for output argument #%d: A Scalar expected.\n"), pstrName, 2);
3374         FREE(pstrName);
3375         throw ast::InternalError(errorMsg);
3376     }
3377
3378     // copy output macro results in output variables
3379     C2F(dcopy)(neq, pDblOutB->get(), &one, b, &one);
3380     *ier = (int)(pDblOutIer->get(0));
3381
3382     // free output arguments
3383     out[0]->DecreaseRef();
3384     if (out[0]->isDeletable())
3385     {
3386         delete out[0];
3387     }
3388
3389     out[1]->DecreaseRef();
3390     if (out[1]->isDeletable())
3391     {
3392         delete out[1];
3393     }
3394 }