1 |
/* ASCEND modelling environment |
2 |
Copyright (C) 2006 Carnegie Mellon University |
3 |
|
4 |
This program is free software; you can redistribute it and/or modify |
5 |
it under the terms of the GNU General Public License as published by |
6 |
the Free Software Foundation; either version 2, or (at your option) |
7 |
any later version. |
8 |
|
9 |
This program is distributed in the hope that it will be useful, |
10 |
but WITHOUT ANY WARRANTY; without even the implied warranty of |
11 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
12 |
GNU General Public License for more details. |
13 |
|
14 |
You should have received a copy of the GNU General Public License |
15 |
along with this program; if not, write to the Free Software |
16 |
Foundation, Inc., 59 Temple Place - Suite 330, |
17 |
Boston, MA 02111-1307, USA. |
18 |
*//** |
19 |
@file |
20 |
Integrator API for ASCEND, for solving systems of ODEs and/or DAEs. |
21 |
*//* |
22 |
by John Pye, May 2006 |
23 |
based on parts of Integrators.c in the Tcl/Tk interface directory, heavily |
24 |
modified to provide a non-GUI-specific API and modularised for multiple |
25 |
integration engines. |
26 |
*/ |
27 |
#include <time.h> |
28 |
#include <string.h> |
29 |
#include "integrator.h" |
30 |
#include "lsode.h" |
31 |
#include "aww.h" |
32 |
#include "ida.h" |
33 |
#include "slv_common.h" |
34 |
#include "slv_client.h" |
35 |
#include <utilities/ascPanic.h> |
36 |
|
37 |
#include "samplelist.h" |
38 |
|
39 |
/** |
40 |
Define as TRUE to enable debug message printing. |
41 |
@TODO this needs to go away. |
42 |
*/ |
43 |
/* #define ANALYSE_DEBUG */ |
44 |
/* #define SOLVE_DEBUG */ |
45 |
/* #define CLASSIFY_DEBUG */ |
46 |
|
47 |
/*------------------------------------------------------------------------------ |
48 |
The following names are of solver_var children or attributes |
49 |
* we support (at least temporarily) to determine who is a state and |
50 |
* who matching derivative. |
51 |
* These should be supported directly in a future solveratominst. |
52 |
*/ |
53 |
|
54 |
static symchar *g_symbols[3]; |
55 |
|
56 |
#define STATEFLAG g_symbols[0] |
57 |
/* |
58 |
Integer child. 0= algebraic, 1 = state, 2 = derivative, 3 = 2nd deriv etc |
59 |
independent variable is -1. |
60 |
*/ |
61 |
#define INTEG_OTHER_VAR -1L |
62 |
#define INTEG_ALGEBRAIC_VAR 0L |
63 |
#define INTEG_STATE_VAR 1L |
64 |
|
65 |
#define STATEINDEX g_symbols[1] |
66 |
/* Integer child. all variables with the same STATEINDEX value are taken to |
67 |
* be derivatives of the same state variable. We really need a compiler |
68 |
* that maintains this info by backpointers, but oh well until then. |
69 |
*/ |
70 |
#define OBSINDEX g_symbols[2] |
71 |
/* Integer child. All variables with OBSINDEX !=0 will be sent to the |
72 |
IntegratorOutputWriteObsFn allowing output to a file, graph, console, etc. |
73 |
*/ |
74 |
|
75 |
|
76 |
/** Temporary catcher of dynamic variable and observation variable data */ |
77 |
struct Integ_var_t { |
78 |
long index; |
79 |
long type; |
80 |
struct Integ_var_t *derivative; |
81 |
struct Integ_var_t *derivative_of; |
82 |
struct var_variable *i; |
83 |
int varindx; /**< index into slv_get_master_vars_list, or -1 if not there */ |
84 |
int isstate; |
85 |
}; |
86 |
|
87 |
/*------------------------------------------------------------------------------ |
88 |
forward declarations |
89 |
*/ |
90 |
|
91 |
/* abstractions of setup/teardown procedures for the specific solvers */ |
92 |
void integrator_create_engine(IntegratorSystem *sys); |
93 |
void integrator_free_engine(IntegratorSystem *sys); |
94 |
|
95 |
IntegratorAnalyseFn integrator_analyse_ode; |
96 |
IntegratorAnalyseFn integrator_analyse_dae; |
97 |
|
98 |
typedef void (IntegratorVarVisitorFn)(IntegratorSystem *sys, struct var_variable *var, const int *varindx); |
99 |
static void integrator_visit_system_vars(IntegratorSystem *sys,IntegratorVarVisitorFn *visitor); |
100 |
IntegratorVarVisitorFn integrator_ode_classify_var; |
101 |
IntegratorVarVisitorFn integrator_dae_classify_var; |
102 |
IntegratorVarVisitorFn integrator_classify_indep_var; |
103 |
IntegratorVarVisitorFn integrator_dae_show_var; |
104 |
|
105 |
static int integrator_sort_obs_vars(IntegratorSystem *sys); |
106 |
static void integrator_print_var_stats(IntegratorSystem *sys); |
107 |
static int integrator_check_indep_var(IntegratorSystem *sys); |
108 |
|
109 |
static int Integ_CmpDynVars(struct Integ_var_t *v1, struct Integ_var_t *v2); |
110 |
static int Integ_CmpObs(struct Integ_var_t *v1, struct Integ_var_t *v2); |
111 |
static void Integ_SetObsId(struct var_variable *v, long oindex); |
112 |
|
113 |
static long DynamicVarInfo(struct var_variable *v,long *vindex); |
114 |
static struct var_variable *ObservationVar(struct var_variable *v, long *oindex); |
115 |
static void IntegInitSymbols(void); |
116 |
|
117 |
/*------------------------------------------------------------------------------ |
118 |
INSTANTIATION AND DESTRUCTION |
119 |
*/ |
120 |
|
121 |
/** |
122 |
Create a new IntegratorSystem and assign a slv_system_t to it. |
123 |
*/ |
124 |
IntegratorSystem *integrator_new(slv_system_t slvsys, struct Instance *inst){ |
125 |
IntegratorSystem *sys; |
126 |
|
127 |
if (slvsys == NULL) { |
128 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"slvsys is NULL!"); |
129 |
return NULL; |
130 |
} |
131 |
|
132 |
sys = ASC_NEW_CLEAR(IntegratorSystem); |
133 |
sys->system = slvsys; |
134 |
sys->instance = inst; |
135 |
|
136 |
sys->engine = INTEG_UNKNOWN; |
137 |
sys->internals = NULL; |
138 |
|
139 |
sys->states = NULL; sys->derivs = NULL; |
140 |
sys->dynvars = NULL; sys->obslist = NULL; sys->indepvars = NULL; |
141 |
|
142 |
sys->y_id = NULL; |
143 |
sys->obs_id = NULL; |
144 |
sys->y = NULL; |
145 |
sys->ydot = NULL; |
146 |
sys->obs = NULL; |
147 |
return sys; |
148 |
} |
149 |
|
150 |
/** |
151 |
Carefully trash any data in the IntegratorSystem that we own, |
152 |
then destroy the IntegratorSystem struct. |
153 |
|
154 |
Note that the integrator doesn't own the samplelist. |
155 |
|
156 |
@param sys will be destroyed and set to NULL. |
157 |
*/ |
158 |
void integrator_free(IntegratorSystem *sys){ |
159 |
if(sys==NULL)return; |
160 |
|
161 |
integrator_free_engine(sys); |
162 |
|
163 |
if(sys->states != NULL)gl_destroy(sys->states); |
164 |
if(sys->derivs != NULL)gl_destroy(sys->derivs); |
165 |
|
166 |
if(sys->dynvars != NULL)gl_free_and_destroy(sys->dynvars); /* we own the objects in dynvars */ |
167 |
if(sys->obslist != NULL)gl_free_and_destroy(sys->obslist); /* and obslist */ |
168 |
if (sys->indepvars != NULL)gl_free_and_destroy(sys->indepvars); /* and indepvars */ |
169 |
|
170 |
/* if(sys->y_id != NULL)ASC_FREE(sys->y_id); */ |
171 |
if(sys->obs_id != NULL)ASC_FREE(sys->obs_id); |
172 |
|
173 |
if(sys->y != NULL && !sys->ycount)ASC_FREE(sys->y); |
174 |
if(sys->ydot != NULL && !sys->ydotcount)ASC_FREE(sys->ydot); |
175 |
if(sys->obs != NULL && !sys->obscount)ASC_FREE(sys->obs); |
176 |
|
177 |
slv_destroy_parms(&(sys->params)); |
178 |
|
179 |
ASC_FREE(sys); |
180 |
CONSOLE_DEBUG("Destroyed IntegratorSystem"); |
181 |
sys=NULL; |
182 |
} |
183 |
|
184 |
/** |
185 |
Utility function to retreive pointers to the symbols we'll be looking for |
186 |
in the instance hierarchy. |
187 |
*/ |
188 |
static void IntegInitSymbols(void){ |
189 |
STATEFLAG = AddSymbol("ode_type"); |
190 |
STATEINDEX = AddSymbol("ode_id"); |
191 |
OBSINDEX = AddSymbol("obs_id"); |
192 |
} |
193 |
|
194 |
/*------------------------------------------------------------------------------ |
195 |
INTEGRATOR ENGINE |
196 |
*/ |
197 |
|
198 |
/** |
199 |
At present, integrators are all present at compile-time so this is a static |
200 |
list; we just return the list. |
201 |
*/ |
202 |
const IntegratorLookup *integrator_get_engines(){ |
203 |
#define S , |
204 |
#define I(N,P) {INTEG_##N, P.name} |
205 |
static const IntegratorLookup list[] = { |
206 |
INTEG_LIST |
207 |
,{INTEG_UNKNOWN,NULL} |
208 |
}; |
209 |
#undef S |
210 |
#undef I |
211 |
return list; |
212 |
} |
213 |
|
214 |
/* return 0 on success */ |
215 |
int integrator_set_engine(IntegratorSystem *sys, IntegratorEngine engine){ |
216 |
|
217 |
CONSOLE_DEBUG("Setting engine..."); |
218 |
|
219 |
/* verify integrator type ok. always passes for nonNULL inst. */ |
220 |
if(engine==INTEG_UNKNOWN){ |
221 |
ERROR_REPORTER_NOLINE(ASC_USER_ERROR |
222 |
,"Integrator has not been specified (or is unknown)." |
223 |
); |
224 |
return 1; |
225 |
}else{ |
226 |
/** @TODO other engine-specific tests */ |
227 |
} |
228 |
|
229 |
if(engine==sys->engine){ |
230 |
return 0; |
231 |
} |
232 |
if(sys->engine!=INTEG_UNKNOWN){ |
233 |
integrator_free_engine(sys); |
234 |
} |
235 |
sys->engine = engine; |
236 |
switch(sys->engine){ |
237 |
#ifdef ASC_WITH_IDA |
238 |
case INTEG_IDA: sys->internals = &integrator_ida_internals; break; |
239 |
#endif |
240 |
case INTEG_LSODE: sys->internals = &integrator_lsode_internals; break; |
241 |
case INTEG_AWW: sys->internals = &integrator_aww_internals; break; |
242 |
default: |
243 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"Unknown integrator engine"); |
244 |
sys->internals = NULL; |
245 |
return 1; |
246 |
}; |
247 |
|
248 |
asc_assert(sys->internals); |
249 |
integrator_create_engine(sys); |
250 |
return 0; |
251 |
} |
252 |
|
253 |
IntegratorEngine integrator_get_engine(const IntegratorSystem *sys){ |
254 |
return sys->engine; |
255 |
} |
256 |
|
257 |
/** |
258 |
Free any engine-specific data that was required for the solution of |
259 |
this system. Note that this data is pointed to by sys->enginedata. |
260 |
*/ |
261 |
void integrator_free_engine(IntegratorSystem *sys){ |
262 |
if(sys->engine==INTEG_UNKNOWN)return; |
263 |
if(sys->enginedata){ |
264 |
if(sys->internals){ |
265 |
(sys->internals->freefn)(sys->enginedata); |
266 |
sys->enginedata=NULL; |
267 |
}else{ |
268 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"Unable to free engine data: no sys->internals"); |
269 |
} |
270 |
} |
271 |
} |
272 |
|
273 |
/** |
274 |
Create enginedata memory if required for this solver. This doesn't include |
275 |
allocating computation space, since we assume that this stage all we know |
276 |
is that we want to use a specified integrator engine, not the full details |
277 |
of the problem at hand. Allocating space inside enginedata should be done |
278 |
during the solve stage (and freed inside integrator_free_engine) |
279 |
*/ |
280 |
void integrator_create_engine(IntegratorSystem *sys){ |
281 |
asc_assert(sys->engine!=INTEG_UNKNOWN); |
282 |
asc_assert(sys->internals); |
283 |
asc_assert(sys->enginedata==NULL); |
284 |
(sys->internals->createfn)(sys); |
285 |
} |
286 |
|
287 |
/*------------------------------------------------------------------------------ |
288 |
PARAMETERS |
289 |
*/ |
290 |
|
291 |
/** |
292 |
Reset the parameters in this IntegratorSystem to the default ones for this |
293 |
Integrator. |
294 |
|
295 |
@return 0 on success, 1 on error |
296 |
*/ |
297 |
int integrator_params_default(IntegratorSystem *sys){ |
298 |
asc_assert(sys->engine!=INTEG_UNKNOWN); |
299 |
asc_assert(sys->internals); |
300 |
return (sys->internals->paramsdefaultfn)(sys); |
301 |
} |
302 |
|
303 |
int integrator_params_get(const IntegratorSystem *sys, slv_parameters_t *parameters){ |
304 |
asc_assert(sys!=NULL); |
305 |
asc_assert(sys->params.num_parms > 0); |
306 |
memcpy(parameters,&(sys->params),sizeof(slv_parameters_t)); |
307 |
return 0; |
308 |
} |
309 |
|
310 |
int integrator_params_set(IntegratorSystem *sys, const slv_parameters_t *parameters){ |
311 |
asc_assert(sys!=NULL); |
312 |
asc_assert(parameters!=NULL); |
313 |
memcpy(&(sys->params),parameters,sizeof(slv_parameters_t)); |
314 |
return 0; |
315 |
} |
316 |
|
317 |
/*------------------------------------------------------------------------------ |
318 |
ANALYSIS |
319 |
|
320 |
Provide two modes in order to provide analysis suitable for solution of both |
321 |
ODEs (the previous technique) and DAEs (new code). These share a common |
322 |
"visit" method that needs to eventually be integrated with the code in |
323 |
<solver/analyze.c>. For the moment, we're just hacking in to the compiler. |
324 |
*/ |
325 |
|
326 |
/** |
327 |
Locate the independent variable. For the purpose of GUI design, this needs |
328 |
to work independent of the integration engine being used. |
329 |
*/ |
330 |
int integrator_find_indep_var(IntegratorSystem *sys){ |
331 |
int result = 0; |
332 |
#ifdef ANALYSE_DEBUG |
333 |
char *varname; |
334 |
#endif |
335 |
|
336 |
if(sys->x != NULL){ |
337 |
CONSOLE_DEBUG("sys->x already set"); |
338 |
return 1; |
339 |
} |
340 |
assert(sys->indepvars==NULL); |
341 |
sys->indepvars = gl_create(10L); |
342 |
|
343 |
IntegInitSymbols(); |
344 |
|
345 |
CONSOLE_DEBUG("Looking for independent var..."); |
346 |
integrator_visit_system_vars(sys,&integrator_classify_indep_var); |
347 |
#ifdef ANALYSE_DEBUG |
348 |
if(gl_length(sys->indepvars)){ |
349 |
CONSOLE_DEBUG("Found %lu indepvars",gl_length(sys->indepvars)); |
350 |
}else{ |
351 |
CONSOLE_DEBUG("NO INDEP VARS FOUND"); |
352 |
} |
353 |
#endif |
354 |
|
355 |
result = integrator_check_indep_var(sys); |
356 |
gl_free_and_destroy(sys->indepvars); |
357 |
sys->indepvars = NULL; |
358 |
|
359 |
#ifdef ANALYSE_DEBUG |
360 |
asc_assert(sys->system); |
361 |
asc_assert(sys->x); |
362 |
varname = var_make_name(sys->system, sys->x); |
363 |
CONSOLE_DEBUG("Indep var is '%s'",varname); |
364 |
ASC_FREE(varname); |
365 |
#endif |
366 |
|
367 |
/* ERROR_REPORTER_HERE(ASC_PROG_NOTE,"Returning result %d",result); */ |
368 |
|
369 |
return result; |
370 |
} |
371 |
|
372 |
/** |
373 |
Analyse the system, either as DAE or as an ODE system, depending on the |
374 |
solver engine selected. |
375 |
|
376 |
@return 1 on success |
377 |
*/ |
378 |
int integrator_analyse(IntegratorSystem *sys){ |
379 |
CONSOLE_DEBUG("Analysing integration system..."); |
380 |
asc_assert(sys); |
381 |
if(sys->engine==INTEG_UNKNOWN){ |
382 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"No engine selected: can't analyse"); |
383 |
return 0; |
384 |
} |
385 |
asc_assert(sys->engine!=INTEG_UNKNOWN); |
386 |
asc_assert(sys->internals); |
387 |
|
388 |
if(!sys->indepvars || !gl_length(sys->indepvars)){ |
389 |
if(!integrator_find_indep_var(sys)){ |
390 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"No independent variable found: abandoning integration"); |
391 |
return 0; |
392 |
} |
393 |
} |
394 |
|
395 |
return (sys->internals->analysefn)(sys); |
396 |
} |
397 |
|
398 |
/** |
399 |
To analyse a DAE we need to identify *ALL* variables in the system |
400 |
Except for the highest-level derivatives of any present? |
401 |
We also need to identify the independent variable (just one). |
402 |
|
403 |
@TODO implement Pantelides algorithm in here? |
404 |
@TODO prevent re-analysis without clearing out the data structures? |
405 |
@return 1 on success |
406 |
*/ |
407 |
int integrator_analyse_dae(IntegratorSystem *sys){ |
408 |
struct Integ_var_t *info, *prev; |
409 |
#ifdef ANALYSE_DEBUG |
410 |
char *varname, *derivname; |
411 |
#endif |
412 |
int i; |
413 |
int numstates; |
414 |
int numy, nrels; |
415 |
int yindex; |
416 |
int maxderiv; |
417 |
|
418 |
CONSOLE_DEBUG("Starting DAE analysis"); |
419 |
IntegInitSymbols(); |
420 |
|
421 |
assert(sys->indepvars==NULL); |
422 |
|
423 |
sys->indepvars = gl_create(10L); /* t var info */ |
424 |
sys->dynvars = gl_create(200L); /* y and ydot var info */ |
425 |
sys->obslist = gl_create(100L); /* obs info */ |
426 |
|
427 |
if(sys->indepvars==NULL |
428 |
|| sys->dynvars==NULL |
429 |
|| sys->obslist==NULL |
430 |
){ |
431 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"Insufficient memory"); |
432 |
return 0; |
433 |
} |
434 |
|
435 |
integrator_visit_system_vars(sys,&integrator_dae_classify_var); |
436 |
|
437 |
#ifdef ANALYSE_DEBUG |
438 |
CONSOLE_DEBUG("Found %lu observation variables:",gl_length(sys->obslist)); |
439 |
for(i=1; i<=gl_length(sys->obslist); ++i){ |
440 |
info = (struct Integ_var_t *)gl_fetch(sys->obslist, i); |
441 |
varname = var_make_name(sys->system,info->i); |
442 |
CONSOLE_DEBUG("observation[%d] = \"%s\"",i,varname); |
443 |
ASC_FREE(varname); |
444 |
} |
445 |
#endif |
446 |
|
447 |
/* CONSOLE_DEBUG("Checking found vars..."); */ |
448 |
if(gl_length(sys->dynvars)==0){ |
449 |
ERROR_REPORTER_HERE(ASC_USER_ERROR,"No solver_var vars found to integrate (check 'ode_type'?)."); |
450 |
return 0; |
451 |
} |
452 |
|
453 |
CONSOLE_DEBUG("Found %lu vars.", gl_length(sys->dynvars)); |
454 |
|
455 |
maxderiv = 0; |
456 |
numstates = 0; |
457 |
for(i=1; i<=gl_length(sys->dynvars); ++i){ |
458 |
info = (struct Integ_var_t *)gl_fetch(sys->dynvars, i); |
459 |
if(info->type==1 || info->type==0)numstates++; |
460 |
if(maxderiv < info->type - 1)maxderiv = info->type - 1; |
461 |
/* varname = var_make_name(sys->system,info->i); |
462 |
CONSOLE_DEBUG("var[%d] = \"%s\": ode_index = %ld",i,varname,info->type); |
463 |
ASC_FREE(varname); */ |
464 |
} |
465 |
if(maxderiv == 0){ |
466 |
ERROR_REPORTER_HERE(ASC_USER_ERROR,"No derivatives found (check 'ode_type' values for your vars)."); |
467 |
return 0; |
468 |
} |
469 |
if(maxderiv > 1){ |
470 |
ERROR_REPORTER_HERE(ASC_USER_ERROR,"Higher-order derivatives found. You must provide a reduced order formulation for your model."); |
471 |
return 0; |
472 |
} |
473 |
|
474 |
if(!integrator_check_indep_var(sys)){ |
475 |
ERROR_REPORTER_HERE(ASC_USER_ERROR,"Independent variable not yet identified"); |
476 |
return 0; |
477 |
} |
478 |
|
479 |
gl_sort(sys->dynvars,(CmpFunc)Integ_CmpDynVars); |
480 |
/* !!! NOTE THAT dynvars IS NOW REARRANGED !!! *sigh* bug hunting(!) */ |
481 |
|
482 |
#ifdef ANALYSE_DEBUG |
483 |
CONSOLE_DEBUG("Variables rearranged to increasing ODE ID & TYPE (varindx = matrix order)"); |
484 |
for(i=1; i<=gl_length(sys->dynvars); ++i){ |
485 |
info = (struct Integ_var_t *)gl_fetch(sys->dynvars, i); |
486 |
varname = var_make_name(sys->system,info->i); |
487 |
CONSOLE_DEBUG("var[%d] = \"%s\": ode_type = %ld (varindx = %d)",i-1,varname,info->type,info->varindx); |
488 |
ASC_FREE(varname); |
489 |
} |
490 |
#endif |
491 |
|
492 |
/* link up variables with their derivatives */ |
493 |
prev = NULL; |
494 |
for(i=1; i<=gl_length(sys->dynvars); ++i){ /* why does gl_list index with base 1??? */ |
495 |
info = (struct Integ_var_t *)gl_fetch(sys->dynvars, i); |
496 |
|
497 |
if(info->type == INTEG_STATE_VAR || info->type == INTEG_ALGEBRAIC_VAR){ |
498 |
#ifdef ANALYSE_DEBUG |
499 |
varname = var_make_name(sys->system,info->i); |
500 |
CONSOLE_DEBUG("Var \"%s\" is an algebraic variable",varname); |
501 |
ASC_FREE(varname); |
502 |
#endif |
503 |
info->type = INTEG_STATE_VAR; |
504 |
info->derivative_of = NULL; |
505 |
}else{ |
506 |
if(prev==NULL || info->index != prev->index){ |
507 |
/* derivative, but without undifferentiated var present in model */ |
508 |
#ifdef ANALYSE_DEBUG |
509 |
varname = var_make_name(sys->system,info->i); |
510 |
ERROR_REPORTER_HERE(ASC_USER_ERROR,"Derivative %d of \"%s\" is present without its un-differentiated equivalent" |
511 |
, info->type-1 |
512 |
, varname |
513 |
); |
514 |
ASC_FREE(varname); |
515 |
#endif |
516 |
return 0; |
517 |
}else if(info->type != prev->type + 1){ |
518 |
/* derivative, but missing the next-lower-order derivative */ |
519 |
#ifdef ANALYSE_DEBUG |
520 |
derivname = var_make_name(sys->system,info->i); |
521 |
varname = var_make_name(sys->system,prev->i); |
522 |
ERROR_REPORTER_HERE(ASC_USER_ERROR |
523 |
,"Looking at \"%s\", expected a derivative (order %d) of \"%s\"." |
524 |
,varname |
525 |
,prev->type+1 |
526 |
,derivname |
527 |
); |
528 |
ASC_FREE(varname); |
529 |
ASC_FREE(derivname); |
530 |
#endif |
531 |
return 0; |
532 |
}else{ |
533 |
/* variable with derivative */ |
534 |
#ifdef ANALYSE_DEBUG |
535 |
varname = var_make_name(sys->system,prev->i); |
536 |
derivname = var_make_name(sys->system,info->i); |
537 |
CONSOLE_DEBUG("Var \"%s\" is the derivative of \"%s\"",derivname,varname); |
538 |
ASC_FREE(varname); |
539 |
ASC_FREE(derivname); |
540 |
#endif |
541 |
info->derivative_of = prev; |
542 |
} |
543 |
} |
544 |
prev = info; |
545 |
} |
546 |
|
547 |
/* record which vars have derivatives and which don't, and count 'states' */ |
548 |
numy = 0; |
549 |
for(i=1; i<=gl_length(sys->dynvars); ++i){ |
550 |
info = (struct Integ_var_t *)gl_fetch(sys->dynvars, i); |
551 |
if(info->derivative_of){ |
552 |
info->derivative_of->derivative = info; |
553 |
}else{ |
554 |
numy++; |
555 |
} |
556 |
} |
557 |
|
558 |
/* allocate storage for the 'y' and 'ydot' arrays */ |
559 |
sys->y = ASC_NEW_ARRAY(struct var_variable *,numy); |
560 |
sys->ydot = ASC_NEW_ARRAY_CLEAR(struct var_variable *,numy); |
561 |
sys->y_id = ASC_NEW_ARRAY(long, slv_get_num_master_vars(sys->system)); |
562 |
|
563 |
for(i=0; i<numy; ++i){ |
564 |
asc_assert(sys->ydot[i]==NULL); |
565 |
} |
566 |
|
567 |
for(i=0; i<numy; ++i){ |
568 |
sys->y_id[i] = 9999999L; |
569 |
} |
570 |
|
571 |
/* now add variables and their derivatives to 'ydot' and 'y' */ |
572 |
yindex = 0; |
573 |
|
574 |
#ifdef ANALYSE_DEBUG |
575 |
CONSOLE_DEBUG("VARS IN THEIR MATRIX ORDER"); |
576 |
#endif |
577 |
for(i=1; i<=gl_length(sys->dynvars); ++i){ |
578 |
info = (struct Integ_var_t *)gl_fetch(sys->dynvars, i); |
579 |
if(info->derivative_of)continue; |
580 |
if(info->derivative){ |
581 |
sys->y[yindex] = info->i; |
582 |
assert(info->derivative); |
583 |
sys->ydot[yindex] = info->derivative->i; |
584 |
if(info->varindx >= 0){ |
585 |
ASC_ASSERT_RANGE(yindex, -1e7L, 1e7L); |
586 |
sys->y_id[info->varindx] = yindex; |
587 |
#ifdef ANALYSE_DEBUG |
588 |
CONSOLE_DEBUG("y_id[%d] = %d",info->varindx,yindex); |
589 |
#endif |
590 |
} |
591 |
if(info->derivative->varindx >= 0){ |
592 |
sys->y_id[info->derivative->varindx] = -1-yindex; |
593 |
ASC_ASSERT_RANGE(-1-yindex,-numy,0); |
594 |
#ifdef ANALYSE_DEBUG |
595 |
CONSOLE_DEBUG("y_id[%d] = %d",info->derivative->varindx,-1-yindex); |
596 |
#endif |
597 |
} |
598 |
}else{ |
599 |
sys->y[yindex] = info ->i; |
600 |
sys->ydot[yindex] = NULL; |
601 |
if(info->varindx >= 0){ |
602 |
sys->y_id[info->varindx] = yindex; |
603 |
ASC_ASSERT_RANGE(yindex,0,numy); |
604 |
#ifdef ANALYSE_DEBUG |
605 |
CONSOLE_DEBUG("y_id[%d] = %d",info->varindx,yindex); |
606 |
#endif |
607 |
} |
608 |
} |
609 |
yindex++; |
610 |
} |
611 |
|
612 |
/* FREE all derivatives and also all states */ |
613 |
for(i=0; i<sys->n_y; ++i){ |
614 |
if(var_fixed(sys->y[i])){ |
615 |
CONSOLE_DEBUG("Freeing state %d",i); |
616 |
var_set_fixed(sys->y[i], FALSE); |
617 |
} |
618 |
if(var_fixed(sys->ydot[i])){ |
619 |
CONSOLE_DEBUG("Freeing derivative %d",i); |
620 |
var_set_fixed(sys->ydot[i], FALSE); |
621 |
} |
622 |
} |
623 |
/* FIX the independent variable (just so that it doesn't appear in relman_diff2 */ |
624 |
asc_assert(sys->x); |
625 |
if(!var_fixed(sys->x)){ |
626 |
CONSOLE_DEBUG("Fixing indep variable"); |
627 |
var_set_fixed(sys->x,TRUE); |
628 |
} |
629 |
|
630 |
nrels = slv_get_num_solvers_rels(sys->system); |
631 |
if(numy != nrels){ |
632 |
ERROR_REPORTER_HERE(ASC_USER_ERROR |
633 |
,"System is not square: solver has %d rels, found %d system states" |
634 |
,nrels, numy |
635 |
); |
636 |
return 0; |
637 |
} |
638 |
|
639 |
CONSOLE_DEBUG("THERE ARE %d VARIABLES IN THE INTEGRATION SYSTEM",numy); |
640 |
|
641 |
sys->n_y = numy; |
642 |
|
643 |
if(!integrator_sort_obs_vars(sys))return 0; |
644 |
|
645 |
#ifdef ANALYSE_DEBUG |
646 |
CONSOLE_DEBUG("RESULTS OF ANALYSIS"); |
647 |
fprintf(stderr,"index\ty\tydot\n"); |
648 |
fprintf(stderr,"-----\t-----\t-----\n"); |
649 |
for(i=0;i<numy;++i){ |
650 |
varname = var_make_name(sys->system, sys->y[i]); |
651 |
fprintf(stderr,"%d\t%s\t",i,varname); |
652 |
if(sys->ydot[i]){ |
653 |
ASC_FREE(varname); |
654 |
varname = var_make_name(sys->system, sys->ydot[i]); |
655 |
fprintf(stderr,"%s\n",varname); |
656 |
ASC_FREE(varname); |
657 |
}else{ |
658 |
fprintf(stderr,"diff(%s)\n",varname); |
659 |
ASC_FREE(varname); |
660 |
} |
661 |
} |
662 |
|
663 |
CONSOLE_DEBUG("CORRESPONDENCE OF SOLVER VARS TO INTEGRATOR VARS"); |
664 |
fprintf(stderr,"index\t%-15s\ty_id\ty\tydot\n","name"); |
665 |
fprintf(stderr,"-----\t%-15s\t-----\t-----\t-----\n","----"); |
666 |
integrator_visit_system_vars(sys,integrator_dae_show_var); |
667 |
#endif |
668 |
|
669 |
return 1; |
670 |
} |
671 |
|
672 |
void integrator_dae_show_var(IntegratorSystem *sys |
673 |
, struct var_variable *var, const int *varindx |
674 |
){ |
675 |
char *varname; |
676 |
long y_id; |
677 |
|
678 |
asc_assert(sys->x); |
679 |
|
680 |
varname = var_make_name(sys->system, var); |
681 |
|
682 |
if(varindx==NULL){ |
683 |
fprintf(stderr,".\t%-15s\t",varname); |
684 |
}else{ |
685 |
fprintf(stderr,"%d\t%-15s\t",*varindx,varname); |
686 |
} |
687 |
|
688 |
if(var==sys->x){ |
689 |
// it's the independent variable |
690 |
fprintf(stderr,"(indep)\n"); |
691 |
}else if(var_fixed(var)){ |
692 |
// it's fixed, so not really a DAE var |
693 |
fprintf(stderr,"(fixed)\n"); |
694 |
}else if(varindx==NULL){ |
695 |
// there's no varindx, so looks like a problem |
696 |
fprintf(stderr,"(not visited?)\n"); |
697 |
}else{ |
698 |
// a DAE var, by elimination |
699 |
y_id = sys->y_id[*varindx]; |
700 |
|
701 |
fprintf(stderr,"%ld", y_id); |
702 |
if(y_id >= 0){ |
703 |
fprintf(stderr,"\ty[%ld]\t.\n",y_id); |
704 |
}else{ |
705 |
fprintf(stderr,"\t.\tydot[%ld]\n",-y_id-1); |
706 |
} |
707 |
|
708 |
ASC_ASSERT_LT(*varindx,1e7L); |
709 |
ASC_ASSERT_LT(y_id, 9999999L); |
710 |
ASC_ASSERT_LT(-9999999L, y_id); |
711 |
} |
712 |
ASC_FREE(varname); |
713 |
} |
714 |
|
715 |
void integrator_visit_system_vars(IntegratorSystem *sys,IntegratorVarVisitorFn *visitfn){ |
716 |
struct var_variable **vlist; |
717 |
int i, vlen; |
718 |
|
719 |
/* visit all the slv_system_t master var lists to collect vars */ |
720 |
/* find the vars mostly in this one */ |
721 |
vlist = slv_get_solvers_var_list(sys->system); |
722 |
vlen = slv_get_num_solvers_vars(sys->system); |
723 |
for (i=0;i<vlen;i++) { |
724 |
(*visitfn)(sys, vlist[i], &i); |
725 |
} |
726 |
|
727 |
/* |
728 |
CONSOLE_DEBUG("Checked %d vars",vlen); |
729 |
integrator_print_var_stats(sys); |
730 |
*/ |
731 |
|
732 |
/* probably nothing here, but gotta check. */ |
733 |
vlist = slv_get_master_par_list(sys->system); |
734 |
vlen = slv_get_num_master_pars(sys->system); |
735 |
for (i=0;i<vlen;i++) { |
736 |
(*visitfn)(sys, vlist[i], NULL); |
737 |
} |
738 |
|
739 |
/* |
740 |
CONSOLE_DEBUG("Checked %d pars",vlen); |
741 |
integrator_print_var_stats(sys); |
742 |
*/ |
743 |
|
744 |
/* might find t here */ |
745 |
vlist = slv_get_master_unattached_list(sys->system); |
746 |
vlen = slv_get_num_master_unattached(sys->system); |
747 |
for (i=0;i<vlen;i++) { |
748 |
(*visitfn)(sys, vlist[i], NULL); |
749 |
} |
750 |
|
751 |
/* CONSOLE_DEBUG("Checked %d unattached",vlen); */ |
752 |
} |
753 |
/** |
754 |
@return 1 on success |
755 |
*/ |
756 |
int integrator_analyse_ode(IntegratorSystem *sys){ |
757 |
struct Integ_var_t *v1,*v2; |
758 |
long half,i,len; |
759 |
int happy=1; |
760 |
char *varname1, *varname2; |
761 |
|
762 |
CONSOLE_DEBUG("Starting ODE analysis"); |
763 |
IntegInitSymbols(); |
764 |
|
765 |
/* collect potential states and derivatives */ |
766 |
sys->indepvars = gl_create(10L); /* t var info */ |
767 |
sys->dynvars = gl_create(200L); /* y ydot var info */ |
768 |
sys->obslist = gl_create(100L); /* obs info */ |
769 |
if (sys->dynvars == NULL |
770 |
|| sys->obslist == NULL |
771 |
|| sys->indepvars == NULL |
772 |
){ |
773 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"Insufficient memory."); |
774 |
return 0; |
775 |
} |
776 |
|
777 |
sys->nstates = sys->nderivs = 0; |
778 |
|
779 |
integrator_visit_system_vars(sys,&integrator_ode_classify_var); |
780 |
|
781 |
integrator_print_var_stats(sys); |
782 |
|
783 |
if(!integrator_check_indep_var(sys))return 0; |
784 |
|
785 |
/* check sanity of state and var lists */ |
786 |
|
787 |
len = gl_length(sys->dynvars); |
788 |
half = len/2; |
789 |
CONSOLE_DEBUG("NUMBER OF DYNAMIC VARIABLES = %ld",half); |
790 |
|
791 |
if (len % 2 || len == 0L || sys->nstates != sys->nderivs ) { |
792 |
/* list length must be even for vars to pair off */ |
793 |
ERROR_REPORTER_NOLINE(ASC_USER_ERROR,"n_y != n_ydot, or no dynamic vars found. Fix your indexing."); |
794 |
return 0; |
795 |
} |
796 |
gl_sort(sys->dynvars,(CmpFunc)Integ_CmpDynVars); |
797 |
if (gl_fetch(sys->dynvars,len)==NULL) { |
798 |
ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"Mysterious NULL found!"); |
799 |
return 0; |
800 |
} |
801 |
sys->states = gl_create(half); /* state vars Integ_var_t references */ |
802 |
sys->derivs = gl_create(half); /* derivative var atoms */ |
803 |
for (i=1;i < len; i+=2) { |
804 |
v1 = (struct Integ_var_t *)gl_fetch(sys->dynvars,i); |
805 |
v2 = (struct Integ_var_t *)gl_fetch(sys->dynvars,i+1); |
806 |
if (v1->type!=1 || v2 ->type !=2 || v1->index != v2->index) { |
807 |
varname1 = var_make_name(sys->system,v1->i); |
808 |
varname2 = var_make_name(sys->system,v2->i); |
809 |
|
810 |
ERROR_REPORTER_HERE(ASC_USER_ERROR,"Mistyped or misindexed dynamic variables: %s (%s = %ld,%s = %ld) and %s (%s = %ld,%s = %ld).", |
811 |
varname1, SCP(STATEFLAG),v1->type,SCP(STATEINDEX),v1->index, |
812 |
varname2, SCP(STATEFLAG),v2->type,SCP(STATEINDEX),v2->index |
813 |
); |
814 |
ASC_FREE(varname1); |
815 |
ASC_FREE(varname2); |
816 |
happy=0; |
817 |
break; |
818 |
} else { |
819 |
gl_append_ptr(sys->states,(POINTER)v1); |
820 |
gl_append_ptr(sys->derivs,(POINTER)v2->i); |
821 |
} |
822 |
} |
823 |
if (!happy) { |
824 |
return 0; |
825 |
} |
826 |
sys->n_y = half; |
827 |
sys->y = ASC_NEW_ARRAY(struct var_variable *, half); |
828 |
sys->y_id = ASC_NEW_ARRAY(long, half); |
829 |
sys->ydot = ASC_NEW_ARRAY(struct var_variable *, half); |
830 |
if (sys->y==NULL || sys->ydot==NULL || sys->y_id==NULL) { |
831 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"Insufficient memory."); |
832 |
return 0; |
833 |
} |
834 |
for (i = 1; i <= half; i++) { |
835 |
v1 = (struct Integ_var_t *)gl_fetch(sys->states,i); |
836 |
sys->y[i-1] = v1->i; |
837 |
sys->y_id[i-1] = v1->index; |
838 |
sys->ydot[i-1] = (struct var_variable *)gl_fetch(sys->derivs,i); |
839 |
} |
840 |
|
841 |
if(!integrator_sort_obs_vars(sys))return 0; |
842 |
|
843 |
/* FIX all states */ |
844 |
for(i=0; i<sys->n_y; ++i){ |
845 |
if(!var_fixed(sys->y[i])){ |
846 |
ERROR_REPORTER_HERE(ASC_USER_WARNING,"Fixing state %d",i); |
847 |
var_set_fixed(sys->y[i], TRUE); |
848 |
} |
849 |
} |
850 |
|
851 |
/* don't need the gl_lists now that we have arrays for everyone */ |
852 |
gl_destroy(sys->states); |
853 |
gl_destroy(sys->derivs); |
854 |
gl_free_and_destroy(sys->indepvars); /* we own the objects in indepvars */ |
855 |
gl_free_and_destroy(sys->dynvars); /* we own the objects in dynvars */ |
856 |
gl_free_and_destroy(sys->obslist); /* and obslist */ |
857 |
sys->states = NULL; |
858 |
sys->derivs = NULL; |
859 |
sys->indepvars = NULL; |
860 |
sys->dynvars = NULL; |
861 |
sys->obslist = NULL; |
862 |
|
863 |
/* analysis completed OK */ |
864 |
return 1; |
865 |
} |
866 |
|
867 |
/** |
868 |
Reindex observations. Sort if the user mostly numbered. Take natural order |
869 |
if user just booleaned. |
870 |
|
871 |
@return 1 on success |
872 |
*/ |
873 |
static int integrator_sort_obs_vars(IntegratorSystem *sys){ |
874 |
int half, i, len = 0; |
875 |
struct Integ_var_t *v2; |
876 |
|
877 |
half = sys->n_y; |
878 |
len = gl_length(sys->obslist); |
879 |
/* we shouldn't be seeing NULL here ever except if malloc fail. */ |
880 |
if (len > 1L) { |
881 |
half = ((struct Integ_var_t *)gl_fetch(sys->obslist,1))->index; |
882 |
/* half != 0 now because we didn't collect 0 indexed vars */ |
883 |
for (i=2; i <= len; i++) { |
884 |
if (half != ((struct Integ_var_t *)gl_fetch(sys->obslist,i))->index) { |
885 |
/* change seen. sort and go on */ |
886 |
gl_sort(sys->obslist,(CmpFunc)Integ_CmpObs); |
887 |
break; |
888 |
} |
889 |
} |
890 |
} |
891 |
for (i = half = 1; i <= len; i++) { |
892 |
v2 = (struct Integ_var_t *)gl_fetch(sys->obslist,i); |
893 |
if (v2==NULL) { |
894 |
/* we shouldn't be seeing NULL here ever except if malloc fail. */ |
895 |
gl_delete(sys->obslist,i,0); /* should not be gl_delete(so,i,1) */ |
896 |
} else { |
897 |
Integ_SetObsId(v2->i,half); |
898 |
v2->index = half++; |
899 |
} |
900 |
} |
901 |
|
902 |
/* obslist now uniquely indexed, no nulls */ |
903 |
/* make into arrays */ |
904 |
half = gl_length(sys->obslist); |
905 |
sys->obs = ASC_NEW_ARRAY(struct var_variable *,half); |
906 |
sys->obs_id = ASC_NEW_ARRAY(long, half); |
907 |
if ( sys->obs==NULL || sys->obs_id==NULL) { |
908 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"Insufficient memory."); |
909 |
return 0; |
910 |
} |
911 |
sys->n_obs = half; |
912 |
for (i = 1; i <= half; i++) { |
913 |
v2 = (struct Integ_var_t *)gl_fetch(sys->obslist,i); |
914 |
sys->obs[i-1] = v2->i; |
915 |
sys->obs_id[i-1] = v2->index; |
916 |
} |
917 |
|
918 |
return 1; |
919 |
} |
920 |
|
921 |
static void integrator_print_var_stats(IntegratorSystem *sys){ |
922 |
int v = gl_length(sys->dynvars); |
923 |
int i = gl_length(sys->indepvars); |
924 |
CONSOLE_DEBUG("Currently %d vars, %d indep",v,i); |
925 |
} |
926 |
|
927 |
/** |
928 |
Check sanity of the independent variable. |
929 |
|
930 |
@return 1 on success |
931 |
*/ |
932 |
static int integrator_check_indep_var(IntegratorSystem *sys){ |
933 |
int len, i; |
934 |
struct Integ_var_t *info; |
935 |
char *varname; |
936 |
|
937 |
if(sys->x){ |
938 |
CONSOLE_DEBUG("Indep var already assigned"); |
939 |
return 1; |
940 |
} |
941 |
|
942 |
/* check the sanity of the independent variable */ |
943 |
len = gl_length(sys->indepvars); |
944 |
if (!len) { |
945 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"No independent variable found."); |
946 |
return 0; |
947 |
} |
948 |
if (len > 1) { |
949 |
ERROR_REPORTER_START_HERE(ASC_USER_ERROR); |
950 |
FPRINTF(ASCERR,"Excess %ld independent variables found:", |
951 |
len); |
952 |
for(i=1; i <=len;i++) { |
953 |
info = (struct Integ_var_t *)gl_fetch(sys->indepvars,i); |
954 |
if(info==NULL)continue; |
955 |
|
956 |
varname = var_make_name(sys->system,info->i); |
957 |
FPRINTF(ASCERR," %s",varname); |
958 |
ASC_FREE(varname); |
959 |
} |
960 |
FPRINTF(ASCERR , "\nSet the \"%s\" flag on all but one of these to %s >= 0.\n" |
961 |
, SCP(STATEFLAG),SCP(STATEFLAG) |
962 |
); |
963 |
error_reporter_end_flush(); |
964 |
return 0; |
965 |
}else{ |
966 |
info = (struct Integ_var_t *)gl_fetch(sys->indepvars,1); |
967 |
sys->x = info->i; |
968 |
} |
969 |
asc_assert(gl_length(sys->indepvars)==1); |
970 |
asc_assert(sys->x); |
971 |
return 1; |
972 |
} |
973 |
|
974 |
/*------------------------------------------------------------------------------ |
975 |
CLASSIFICATION OF VARIABLES (for ANALYSIS step) |
976 |
*/ |
977 |
|
978 |
#define INTEG_ADD_TO_LIST(info,TYPE,INDEX,VAR,VARINDX,LIST) \ |
979 |
info = ASC_NEW(struct Integ_var_t); \ |
980 |
if(info==NULL){ \ |
981 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"Insufficient memory (INTEG_VAR_NEW)"); \ |
982 |
return; \ |
983 |
} \ |
984 |
info->type=TYPE; \ |
985 |
info->index=INDEX; \ |
986 |
info->i=VAR; \ |
987 |
info->derivative=NULL; \ |
988 |
info->derivative_of=NULL; \ |
989 |
if(VARINDX==NULL){ \ |
990 |
info->varindx = -1; \ |
991 |
}else{ \ |
992 |
info->varindx = *VARINDX; \ |
993 |
} \ |
994 |
gl_append_ptr(LIST,(void *)info); \ |
995 |
info = NULL |
996 |
|
997 |
/** |
998 |
In a DAE, it's either the (single) independent variable, or it's a |
999 |
variable in the model. |
1000 |
|
1001 |
I'm not sure what we should be doing with variables that are already |
1002 |
present as derivatives of other variables, I guess those ones need to be |
1003 |
removed from the list in a second pass? |
1004 |
*/ |
1005 |
void integrator_dae_classify_var(IntegratorSystem *sys |
1006 |
, struct var_variable *var, const int *varindx |
1007 |
){ |
1008 |
struct Integ_var_t *info; |
1009 |
long type,index; |
1010 |
|
1011 |
/* filter for recognition of solver_vars */ |
1012 |
var_filter_t vfilt; |
1013 |
vfilt.matchbits = VAR_SVAR; |
1014 |
vfilt.matchvalue = VAR_SVAR; |
1015 |
|
1016 |
assert(var != NULL && var_instance(var)!=NULL ); |
1017 |
|
1018 |
if( var_apply_filter(var,&vfilt) ) { |
1019 |
if(!var_active(var)){ |
1020 |
CONSOLE_DEBUG("VARIABLE IS NOT ACTIVE"); |
1021 |
return; |
1022 |
} |
1023 |
|
1024 |
/* only non-fixed variables are accepted */ |
1025 |
if(!var_fixed(var)){ |
1026 |
/* get the ode_type and ode_id of this solver_var */ |
1027 |
type = DynamicVarInfo(var,&index); |
1028 |
|
1029 |
if(type==INTEG_OTHER_VAR){ |
1030 |
/* if the var's type is -1, it's independent */ |
1031 |
INTEG_ADD_TO_LIST(info,INTEG_OTHER_VAR,0,var,varindx,sys->indepvars); |
1032 |
}else{ |
1033 |
if(type < 0)type=0; |
1034 |
/* any other type of var is in the DAE system, at least for now */ |
1035 |
INTEG_ADD_TO_LIST(info,type,index,var,varindx,sys->dynvars); |
1036 |
} |
1037 |
} |
1038 |
#if 0 |
1039 |
else{ |
1040 |
/* fixed variable, only include it if ode_type == 1 */ |
1041 |
type = DynamicVarInfo(var,&index); |
1042 |
if(type==INTEG_STATE_VAR){ |
1043 |
INTEG_ADD_TO_LIST(info,type,index,var,varindx,sys->dynvars); |
1044 |
} |
1045 |
} |
1046 |
#endif |
1047 |
|
1048 |
/* if the var's obs_id > 0, add it to the observation list */ |
1049 |
if(ObservationVar(var,&index) != NULL && index > 0L) { |
1050 |
INTEG_ADD_TO_LIST(info,type,index,var,varindx,sys->obslist); |
1051 |
} |
1052 |
} |
1053 |
} |
1054 |
|
1055 |
/** |
1056 |
Inspect a specific variable and work out what type it is (what 'ode_type' it |
1057 |
has) and what other variable(s) it corresponds to (ie dydt corresponds to |
1058 |
y as a derivative). |
1059 |
|
1060 |
@TODO add ability to create new variables for 'missing' derivative vars? |
1061 |
*/ |
1062 |
void integrator_ode_classify_var(IntegratorSystem *sys, struct var_variable *var |
1063 |
, const int *varindx |
1064 |
){ |
1065 |
struct Integ_var_t *info; |
1066 |
long type,index; |
1067 |
|
1068 |
var_filter_t vfilt; |
1069 |
vfilt.matchbits = VAR_SVAR; |
1070 |
vfilt.matchvalue = VAR_SVAR; |
1071 |
|
1072 |
assert(var != NULL && var_instance(var)!=NULL ); |
1073 |
|
1074 |
if( var_apply_filter(var,&vfilt) ) { |
1075 |
/* it's a solver var: what type of variable? */ |
1076 |
type = DynamicVarInfo(var,&index); |
1077 |
|
1078 |
if(type==INTEG_ALGEBRAIC_VAR){ |
1079 |
/* no action required */ |
1080 |
}else if(type==INTEG_OTHER_VAR){ |
1081 |
/* i.e. independent var */ |
1082 |
INTEG_ADD_TO_LIST(info,type,index,var,varindx,sys->indepvars); |
1083 |
}else if(type>=INTEG_STATE_VAR){ |
1084 |
INTEG_ADD_TO_LIST(info,type,index,var,varindx,sys->dynvars); |
1085 |
if(type == 1){ |
1086 |
sys->nstates++; |
1087 |
}else if(type == 2){ /* what about higher-order derivatives? -- JP */ |
1088 |
sys->nderivs++; |
1089 |
}else{ |
1090 |
ERROR_REPORTER_HERE(ASC_USER_WARNING,"Higher-order (>=2) derivatives are not supported in ODEs."); |
1091 |
} } |
1092 |
|
1093 |
if(ObservationVar(var,&index) != NULL && index > 0L) { |
1094 |
INTEG_ADD_TO_LIST(info,0L,index,var,varindx,sys->obslist); |
1095 |
} |
1096 |
} |
1097 |
} |
1098 |
|
1099 |
/** |
1100 |
Look at a variable and determine if it's the independent variable or not. |
1101 |
This is just for the purpose of the integrator_find_indep_var function, |
1102 |
which is a utility function provided for use by the GUI. |
1103 |
*/ |
1104 |
void integrator_classify_indep_var(IntegratorSystem *sys |
1105 |
, struct var_variable *var, const int *varindx |
1106 |
){ |
1107 |
struct Integ_var_t *info; |
1108 |
long type,index; |
1109 |
var_filter_t vfilt; |
1110 |
#ifdef CLASSIFY_DEBUG |
1111 |
char *varname; |
1112 |
#endif |
1113 |
|
1114 |
assert(var != NULL && var_instance(var)!=NULL ); |
1115 |
vfilt.matchbits = VAR_SVAR; |
1116 |
vfilt.matchvalue = VAR_SVAR; |
1117 |
|
1118 |
#ifdef CLASSIFY_DEBUG |
1119 |
varname = var_make_name(sys->system,var); |
1120 |
#endif |
1121 |
|
1122 |
if( var_apply_filter(var,&vfilt) ) { |
1123 |
type = DynamicVarInfo(var,&index); |
1124 |
|
1125 |
if(type==INTEG_OTHER_VAR){ |
1126 |
/* i.e. independent var */ |
1127 |
#ifdef CLASSIFY_DEBUG |
1128 |
CONSOLE_DEBUG("Var '%s' added to indepvars",varname); |
1129 |
#endif |
1130 |
INTEG_ADD_TO_LIST(info,type,index,var,varindx,sys->indepvars); |
1131 |
#ifdef CLASSIFY_DEBUG |
1132 |
}else{ |
1133 |
CONSOLE_DEBUG("Var '%s' not correct ode_type",varname); |
1134 |
#endif |
1135 |
} |
1136 |
#ifdef CLASSIFY_DEBUG |
1137 |
}else{ |
1138 |
CONSOLE_DEBUG("Var '%s' failed filter",varname); |
1139 |
#endif |
1140 |
} |
1141 |
|
1142 |
#ifdef CLASSIFY_DEBUG |
1143 |
ASC_FREE(varname); |
1144 |
#endif |
1145 |
} |
1146 |
|
1147 |
/** |
1148 |
Look at a variable, and if it is an 'ODE variable' (it has a child instance |
1149 |
named 'ode_type') return its type, which will be either: |
1150 |
- INTEG_OTHER_VAR (if 'ode_type' is -1) |
1151 |
- INTEG_ALGEBRAIC_VAR (if 'ode_type' is zero or any negative value < -1) |
1152 |
- INTEG_STATE_VAR (if 'ode_type' is 1) |
1153 |
- values 2, 3 or up, indicating derivatives (1st deriv=2, 2nd deriv=3, etc) |
1154 |
|
1155 |
If the parameter 'index' is not null, the value of 'ode_id' will be stuffed |
1156 |
there. |
1157 |
*/ |
1158 |
static long DynamicVarInfo(struct var_variable *v,long *index){ |
1159 |
struct Instance *c, *d, *i; |
1160 |
i = var_instance(v); |
1161 |
assert(i!=NULL); |
1162 |
assert(STATEFLAG!=NULL); |
1163 |
assert(STATEINDEX!=NULL); |
1164 |
c = ChildByChar(i,STATEFLAG); |
1165 |
d = ChildByChar(i,STATEINDEX); |
1166 |
/* lazy evaluation is important in the following if */ |
1167 |
if(c == NULL |
1168 |
|| d == NULL |
1169 |
|| InstanceKind(c) != INTEGER_INST |
1170 |
|| InstanceKind(d) != INTEGER_INST |
1171 |
|| !AtomAssigned(c) |
1172 |
|| (!AtomAssigned(d) && GetIntegerAtomValue(c) != INTEG_OTHER_VAR) |
1173 |
){ |
1174 |
return INTEG_ALGEBRAIC_VAR; |
1175 |
} |
1176 |
if (index != NULL) { |
1177 |
*index = GetIntegerAtomValue(d); |
1178 |
} |
1179 |
return GetIntegerAtomValue(c); |
1180 |
} |
1181 |
|
1182 |
/** |
1183 |
Looks at the given variable checks if it is an 'observation variable'. This |
1184 |
means that it has its 'obs_id' child instance set to a non-zero value. |
1185 |
|
1186 |
If the variable is an observation variable, its index value ('obs_id') is |
1187 |
stuff into *index (provided index!=NULL), and the pointer to the original |
1188 |
instance is rtruend. |
1189 |
|
1190 |
If it's not an observation variable, we return NULL and *index is untouched. |
1191 |
*/ |
1192 |
static struct var_variable *ObservationVar(struct var_variable *v, long *index){ |
1193 |
struct Instance *c,*i; |
1194 |
i = var_instance(v); |
1195 |
assert(i!=NULL); |
1196 |
c = ChildByChar(i,OBSINDEX); |
1197 |
if( c == NULL || InstanceKind(c) != INTEGER_INST || !AtomAssigned(c)) { |
1198 |
return NULL; |
1199 |
} |
1200 |
if (index != NULL) { |
1201 |
*index = GetIntegerAtomValue(c); |
1202 |
} |
1203 |
return v; |
1204 |
} |
1205 |
|
1206 |
/*------------------------------------------------------------------------------ |
1207 |
RUNNING THE SOLVER |
1208 |
*/ |
1209 |
|
1210 |
/* |
1211 |
Make the call to the actual integrator we've selected, for the range of |
1212 |
time values specified. The sys contains all the specifics. |
1213 |
|
1214 |
Return 1 on success |
1215 |
*/ |
1216 |
int integrator_solve(IntegratorSystem *sys, long i0, long i1){ |
1217 |
|
1218 |
long nstep; |
1219 |
unsigned long start_index=0, finish_index=0; |
1220 |
assert(sys!=NULL); |
1221 |
|
1222 |
assert(sys->internals); |
1223 |
assert(sys->engine!=INTEG_UNKNOWN); |
1224 |
|
1225 |
nstep = integrator_getnsamples(sys)-1; |
1226 |
/* check for at least 2 steps and dimensionality of x vs steps here */ |
1227 |
|
1228 |
if (i0<0 || i1 <0) { |
1229 |
/* dude, there's no way we're writing interactive stuff here... */ |
1230 |
ERROR_REPORTER_HERE(ASC_PROG_ERROR,"Console input of integration limits has been disabled!"); |
1231 |
return 0; |
1232 |
} else { |
1233 |
start_index=i0; |
1234 |
finish_index =i1; |
1235 |
if (start_index >= (unsigned long)nstep) { |
1236 |
ERROR_REPORTER_NOLINE(ASC_USER_ERROR,"Start point (=%lu) must be an index in the range [0,%li]." |
1237 |
,start_index,nstep |
1238 |
); |
1239 |
return 0; |
1240 |
} |
1241 |
if (finish_index > (unsigned long)nstep) { |
1242 |
ERROR_REPORTER_NOLINE(ASC_USER_ERROR,"End point (=%lu) must be an index in the range [0,%li]." |
1243 |
,finish_index,nstep |
1244 |
); |
1245 |
return 0; |
1246 |
} |
1247 |
} |
1248 |
|
1249 |
if(finish_index <= start_index) { |
1250 |
ERROR_REPORTER_NOLINE(ASC_USER_ERROR,"End point comes before start point! (start=%lu, end=%lu)" |
1251 |
,start_index,finish_index |
1252 |
); |
1253 |
return 0; |
1254 |
} |
1255 |
|
1256 |
CONSOLE_DEBUG("RUNNING INTEGRATION..."); |
1257 |
|
1258 |
return (sys->internals->solvefn)(sys,start_index,finish_index); |
1259 |
} |
1260 |
|
1261 |
/*--------------------------------------------------------------- |
1262 |
HANDLING THE LIST OF TIMESTEMPS |
1263 |
*/ |
1264 |
|
1265 |
#define GETTER_AND_SETTER(TYPE,NAME) \ |
1266 |
void integrator_set_##NAME(IntegratorSystem *sys, TYPE val){ \ |
1267 |
sys->NAME=val; \ |
1268 |
} \ |
1269 |
TYPE integrator_get_##NAME(IntegratorSystem *sys){ \ |
1270 |
return sys->NAME; \ |
1271 |
} |
1272 |
|
1273 |
GETTER_AND_SETTER(SampleList *,samples) /*;*/ |
1274 |
GETTER_AND_SETTER(double,maxstep) /*;*/ |
1275 |
GETTER_AND_SETTER(double,minstep) /*;*/ |
1276 |
GETTER_AND_SETTER(double,stepzero) /*;*/ |
1277 |
GETTER_AND_SETTER(int,maxsubsteps) /*;*/ |
1278 |
#undef GETTER_AND_SETTER |
1279 |
|
1280 |
long integrator_getnsamples(IntegratorSystem *sys){ |
1281 |
assert(sys!=NULL); |
1282 |
assert(sys->samples!=NULL); |
1283 |
return samplelist_length(sys->samples); |
1284 |
} |
1285 |
|
1286 |
double integrator_getsample(IntegratorSystem *sys, long i){ |
1287 |
assert(sys!=NULL); |
1288 |
assert(sys->samples!=NULL); |
1289 |
return samplelist_get(sys->samples,i); |
1290 |
} |
1291 |
|
1292 |
void integrator_setsample(IntegratorSystem *sys, long i,double xi){ |
1293 |
assert(sys!=NULL); |
1294 |
assert(sys->samples!=NULL); |
1295 |
samplelist_set(sys->samples,i,xi); |
1296 |
} |
1297 |
|
1298 |
const dim_type *integrator_getsampledim(IntegratorSystem *sys){ |
1299 |
assert(sys!=NULL); |
1300 |
assert(sys->samples!=NULL); |
1301 |
return samplelist_dim(sys->samples); |
1302 |
} |
1303 |
|
1304 |
ASC_DLLSPEC(long) integrator_getcurrentstep(IntegratorSystem *sys){ |
1305 |
return sys->currentstep; |
1306 |
} |
1307 |
|
1308 |
/*------------------------------------------------------------------------------ |
1309 |
GET/SET VALUE OF THE INDEP VARIABLE |
1310 |
*/ |
1311 |
|
1312 |
/** |
1313 |
Retrieve the value of the independent variable (time) from ASCEND |
1314 |
and return it as a double. |
1315 |
*/ |
1316 |
double integrator_get_t(IntegratorSystem *sys){ |
1317 |
assert(sys->x!=NULL); |
1318 |
return var_value(sys->x); |
1319 |
} |
1320 |
|
1321 |
/** |
1322 |
Set the value of the independent variable (time) in ASCEND. |
1323 |
*/ |
1324 |
void integrator_set_t(IntegratorSystem *sys, double value){ |
1325 |
var_set_value(sys->x, value); |
1326 |
/* CONSOLE_DEBUG("set_t = %g", value); */ |
1327 |
} |
1328 |
|
1329 |
/*------------------------------------------------------------------------------ |
1330 |
PASSING DIFFERENTIAL VARIABLES AND THEIR DERIVATIVES TO/FROM THE SOLVER |
1331 |
*/ |
1332 |
/** |
1333 |
Retrieve the current values of the derivatives of the y-variables |
1334 |
and stick them in the/an array that the integrator will use. |
1335 |
|
1336 |
If the pointer 'y' is NULL, the necessary space is allocated (and |
1337 |
must be freed somewhere else). |
1338 |
*/ |
1339 |
double *integrator_get_y(IntegratorSystem *sys, double *y) { |
1340 |
long i; |
1341 |
|
1342 |
if (y==NULL) { |
1343 |
y = ASC_NEW_ARRAY_CLEAR(double, sys->n_y+1); |
1344 |
/* C y[0] <==> ascend d.y[1] <==> f77 y(1) */ |
1345 |
} |
1346 |
|
1347 |
for (i=0; i< sys->n_y; i++) { |
1348 |
assert(sys->y[i]!=NULL); |
1349 |
y[i] = var_value(sys->y[i]); |
1350 |
/* CONSOLE_DEBUG("ASCEND --> y[%ld] = %g", i+1, y[i]); */ |
1351 |
} |
1352 |
return y; |
1353 |
} |
1354 |
|
1355 |
/** |
1356 |
Take the values of the derivatives from the array that the integrator |
1357 |
uses, and use them to update the values of the corresponding variables |
1358 |
in ASCEND. |
1359 |
*/ |
1360 |
void integrator_set_y(IntegratorSystem *sys, double *y) { |
1361 |
long i; |
1362 |
#ifdef SOLVE_DEBUG |
1363 |
char *varname; |
1364 |
#endif |
1365 |
|
1366 |
for (i=0; i < sys->n_y; i++) { |
1367 |
assert(sys->y[i]!=NULL); |
1368 |
var_set_value(sys->y[i],y[i]); |
1369 |
#ifdef SOLVE_DEBUG |
1370 |
varname = var_make_name(sys->system, sys->y[i]); |
1371 |
CONSOLE_DEBUG("y[%ld] = %g --> '%s'", i+1, y[i], varname); |
1372 |
ASC_FREE(varname); |
1373 |
#endif |
1374 |
} |
1375 |
} |
1376 |
|
1377 |
/** |
1378 |
Send the values of the derivatives of the 'y' variables to the solver. |
1379 |
Allocate space for an array if necessary. |
1380 |
|
1381 |
Any element in sys->ydot that is NULL will be passed over (the value |
1382 |
won't be modified in dydx). |
1383 |
*/ |
1384 |
double *integrator_get_ydot(IntegratorSystem *sys, double *dydx) { |
1385 |
long i; |
1386 |
|
1387 |
if (dydx==NULL) { |
1388 |
dydx = ASC_NEW_ARRAY_CLEAR(double, sys->n_y+1); |
1389 |
/* C dydx[0] <==> ascend d.dydx[1] <==> f77 ydot(1) */ |
1390 |
} |
1391 |
|
1392 |
for (i=0; i < sys->n_y; i++) { |
1393 |
if(sys->ydot[i]!=NULL){ |
1394 |
dydx[i] = var_value(sys->ydot[i]); |
1395 |
} |
1396 |
/* CONSOLE_DEBUG("ASCEND --> ydot[%ld] = %g", i+1, dydx[i]); */ |
1397 |
} |
1398 |
return dydx; |
1399 |
} |
1400 |
|
1401 |
void integrator_set_ydot(IntegratorSystem *sys, double *dydx) { |
1402 |
long i; |
1403 |
#ifdef SOLVE_DEBUG |
1404 |
char *varname; |
1405 |
#endif |
1406 |
for (i=0; i < sys->n_y; i++) { |
1407 |
if(sys->ydot[i]!=NULL){ |
1408 |
var_set_value(sys->ydot[i],dydx[i]); |
1409 |
#ifdef SOLVE_DEBUG |
1410 |
varname = var_make_name(sys->system, sys->ydot[i]); |
1411 |
CONSOLE_DEBUG("ydot[%ld] = \"%s\" = %g --> ASCEND", i+1, varname, dydx[i]); |
1412 |
ASC_FREE(varname); |
1413 |
}else{ |
1414 |
CONSOLE_DEBUG("ydot[%ld] = %g (internal)", i+1, dydx[i]); |
1415 |
#endif |
1416 |
} |
1417 |
} |
1418 |
} |
1419 |
|
1420 |
/** |
1421 |
Retrieve the values of 'ode_atol' properties of each of y-variables, |
1422 |
for use in setting absolute error tolerances for the Integrator. |
1423 |
|
1424 |
If the pointer 'atol' is NULL, the necessary space is allocated (and |
1425 |
must be freed somewhere else). |
1426 |
*/ |
1427 |
double *integrator_get_atol(IntegratorSystem *sys, double *atol){ |
1428 |
long i; |
1429 |
char *varname; |
1430 |
|
1431 |
if (atol==NULL) { |
1432 |
atol = ASC_NEW_ARRAY_CLEAR(double, sys->n_y); |
1433 |
} |
1434 |
|
1435 |
for (i=0; i< sys->n_y; i++) { |
1436 |
assert(sys->y[i]!=NULL); |
1437 |
atol[i] = var_odeatol(sys->y[i]); |
1438 |
assert(atol[i]!=-1); |
1439 |
varname = var_make_name(sys->system,sys->y[i]); |
1440 |
CONSOLE_DEBUG("%s.ode_atol = %8.2e",varname,atol[i]); |
1441 |
ASC_FREE(varname); |
1442 |
} |
1443 |
return atol; |
1444 |
} |
1445 |
|
1446 |
/*------------------------------------------------------------- |
1447 |
RETRIEVING OBSERVATION DATA |
1448 |
*/ |
1449 |
|
1450 |
/** |
1451 |
This function takes the inst in the solver and returns the vector of |
1452 |
observation variables that are located in the submodel d.obs array. |
1453 |
*/ |
1454 |
double *integrator_get_observations(IntegratorSystem *sys, double *obsi) { |
1455 |
long i; |
1456 |
|
1457 |
if (obsi==NULL) { |
1458 |
obsi = ASC_NEW_ARRAY_CLEAR(double, sys->n_obs+1); |
1459 |
} |
1460 |
|
1461 |
/* C obsi[0] <==> ascend d.obs[1] */ |
1462 |
|
1463 |
for (i=0; i < sys->n_obs; i++) { |
1464 |
obsi[i] = var_value(sys->obs[i]); |
1465 |
/* CONSOLE_DEBUG("*get_d_obs[%ld] = %g\n", i+1, obsi[i]); */ |
1466 |
} |
1467 |
return obsi; |
1468 |
} |
1469 |
|
1470 |
struct var_variable *integrator_get_observed_var(IntegratorSystem *sys, const long i){ |
1471 |
assert(i>=0); |
1472 |
assert(i<sys->n_obs); |
1473 |
return sys->obs[i]; |
1474 |
} |
1475 |
|
1476 |
/** |
1477 |
@NOTE Although this shouldn't be required for implementation of solver |
1478 |
engines, this is useful for GUI reporting of integration results. |
1479 |
*/ |
1480 |
struct var_variable *integrator_get_independent_var(IntegratorSystem *sys){ |
1481 |
return sys->x; |
1482 |
} |
1483 |
|
1484 |
|
1485 |
/*---------------------------------------------------- |
1486 |
Build an analytic jacobian for solving the state system |
1487 |
|
1488 |
This necessarily ugly piece of code attempts to create a unique |
1489 |
list of relations that explicitly contain the variables in the |
1490 |
given input list. The utility of this information is that we know |
1491 |
exactly which relations must be differentiated, to fill in the |
1492 |
df/dy matrix. If the problem has very few derivative terms, this will |
1493 |
be of great savings. If the problem arose from the discretization of |
1494 |
a pde, then this will be not so useful. The decision wether to use |
1495 |
this function or to simply differentiate the entire relations list |
1496 |
must be done before calling this function. |
1497 |
|
1498 |
Final Note: the callee owns the array, but not the array elements. |
1499 |
*/ |
1500 |
#define AVG_NUM_INCIDENT 4 |
1501 |
|
1502 |
|
1503 |
/** |
1504 |
This function helps to arrange the observation variables in a sensible order. |
1505 |
The 'obs_id' child instance of v, if present, is assigned the value of the |
1506 |
given parameter 'index'. |
1507 |
*/ |
1508 |
static void Integ_SetObsId(struct var_variable *v, long index){ |
1509 |
struct Instance *c, *i; |
1510 |
i = var_instance(v); |
1511 |
assert(i!=NULL); |
1512 |
c = ChildByChar(i,OBSINDEX); |
1513 |
if( c == NULL || InstanceKind(c) != INTEGER_INST || !AtomAssigned(c)) { |
1514 |
return; |
1515 |
} |
1516 |
SetIntegerAtomValue(c,index,0); |
1517 |
} |
1518 |
|
1519 |
/** |
1520 |
Compares observation structs. NULLs should end up at far end. |
1521 |
*/ |
1522 |
static int Integ_CmpObs(struct Integ_var_t *v1, struct Integ_var_t *v2){ |
1523 |
if(v1 == NULL)return 1; |
1524 |
if(v2 == NULL)return -1; |
1525 |
if(v1->index > v2->index)return 1; |
1526 |
if(v1->index == v2->index)return 0; |
1527 |
return -1; |
1528 |
} |
1529 |
|
1530 |
/** |
1531 |
Compares dynamic vars structs. NULLs should end up at far end. |
1532 |
List should be sorted primarily by index and then by type, in order |
1533 |
of increasing value of both. |
1534 |
*/ |
1535 |
static int Integ_CmpDynVars(struct Integ_var_t *v1, struct Integ_var_t *v2){ |
1536 |
if(v1 == NULL)return 1; |
1537 |
if(v2 == NULL)return -1; |
1538 |
if(v1->index > v2->index)return 1; |
1539 |
if(v1->index != v2->index)return -1; |
1540 |
if(v1->type > v2->type)return 1; |
1541 |
return -1; |
1542 |
} |
1543 |
/*---------------------------- |
1544 |
Output handling to the GUI/interface. |
1545 |
*/ |
1546 |
|
1547 |
int integrator_set_reporter(IntegratorSystem *sys |
1548 |
, IntegratorReporter *reporter |
1549 |
){ |
1550 |
assert(sys!=NULL); |
1551 |
sys->reporter = reporter; |
1552 |
/* ERROR_REPORTER_HERE(ASC_PROG_NOTE,"INTEGRATOR REPORTER HOOKS HAVE BEEN SET\n"); */ |
1553 |
return 1; |
1554 |
} |
1555 |
|
1556 |
int integrator_output_init(IntegratorSystem *sys){ |
1557 |
assert(sys!=NULL); |
1558 |
assert(sys->reporter!=NULL); |
1559 |
if(sys->reporter->init!=NULL){ |
1560 |
/* call the specified output function */ |
1561 |
return (*(sys->reporter->init))(sys); |
1562 |
} |
1563 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"No integrator reporter init method"); |
1564 |
return 1; |
1565 |
} |
1566 |
|
1567 |
int integrator_output_write(IntegratorSystem *sys){ |
1568 |
static int reported_already=0; |
1569 |
assert(sys!=NULL); |
1570 |
if(sys->reporter->write!=NULL){ |
1571 |
return (*(sys->reporter->write))(sys); |
1572 |
} |
1573 |
if(!reported_already){ |
1574 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"No integrator reporter write method (this message only shown once)"); |
1575 |
reported_already=1; |
1576 |
} |
1577 |
return 1; |
1578 |
} |
1579 |
|
1580 |
int integrator_output_write_obs(IntegratorSystem *sys){ |
1581 |
static int reported_already=0; |
1582 |
assert(sys!=NULL); |
1583 |
if(sys->reporter->write_obs!=NULL){ |
1584 |
return (*(sys->reporter->write_obs))(sys); |
1585 |
} |
1586 |
if(!reported_already){ |
1587 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"No integrator reporter write_obs method (this message only shown once)"); |
1588 |
reported_already=1; |
1589 |
} |
1590 |
return 1; |
1591 |
} |
1592 |
|
1593 |
int integrator_output_close(IntegratorSystem *sys){ |
1594 |
assert(sys!=NULL); |
1595 |
if(sys->reporter->close!=NULL){ |
1596 |
return (*(sys->reporter->close))(sys); |
1597 |
} |
1598 |
ERROR_REPORTER_HERE(ASC_PROG_ERR,"No integrator reporter close method"); |
1599 |
return 1; |
1600 |
} |
1601 |
|
1602 |
/** |
1603 |
Decode status codes from the integrator, and output them via FPRINTF. |
1604 |
*/ |
1605 |
int integrator_checkstatus(slv_status_t status) { |
1606 |
if (status.converged) { |
1607 |
return 1; |
1608 |
} |
1609 |
if (status.diverged) { |
1610 |
FPRINTF(stderr, "The derivative system did not converge. Integration will terminate."); |
1611 |
return 0; |
1612 |
} |
1613 |
if (status.inconsistent) { |
1614 |
FPRINTF(stderr, "A numerically inconsistent state was discovered while " |
1615 |
"calculating derivatives. Integration will terminate."); |
1616 |
return 0; |
1617 |
} |
1618 |
if (status.time_limit_exceeded) { |
1619 |
FPRINTF(stderr, "The time limit was exceeded while calculating " |
1620 |
"derivatives. Integration will terminate."); |
1621 |
return 0; |
1622 |
} |
1623 |
if (status.iteration_limit_exceeded) { |
1624 |
FPRINTF(stderr, "The iteration limit was exceeded while calculating " |
1625 |
"derivatives. Integration will terminate."); |
1626 |
return 0; |
1627 |
} |
1628 |
if (status.panic) { |
1629 |
FPRINTF(stderr, "The user patience limit was exceeded while " |
1630 |
"calculating derivatives. Integration will terminate."); |
1631 |
return 0; |
1632 |
} |
1633 |
return 0; |
1634 |
} |