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