/[ascend]/trunk/base/generic/solver/integrator.c
ViewVC logotype

Contents of /trunk/base/generic/solver/integrator.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 991 - (show annotations) (download) (as text)
Thu Dec 21 10:44:32 2006 UTC (16 years, 9 months ago) by johnpye
File MIME type: text/x-csrc
File size: 47164 byte(s)
Added IDA 'MAXNCF' option.
Added TestIDA.testlotkaDENSE.
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 }

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22