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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 944 - (show annotations) (download) (as text)
Sat Nov 25 10:46:13 2006 UTC (14 years, 1 month ago) by johnpye
File MIME type: text/x-csrc
File size: 16999 byte(s)
Implemented ATOLVECT, ATOL, RTOL parameters for the IDA integrator.
1 /*
2 * SLV: Ascend Numeric Solver
3 * by Karl Michael Westerberg
4 * Created: 2/6/90
5 * Version: $Revision: 1.31 $
6 * Version control file: $RCSfile: var.c,v $
7 * Date last modified: $Date: 1998/02/19 13:31:36 $
8 * Last modified by: $Author: mthomas $
9 *
10 * This file is part of the SLV solver.
11 *
12 * Copyright (C) 1990 Karl Michael Westerberg
13 * Copyright (C) 1993 Joseph Zaher
14 * Copyright (C) 1994 Joseph Zaher, Benjamin Andrew Allan
15 *
16 * The SLV solver is free software; you can redistribute
17 * it and/or modify it under the terms of the GNU General Public License as
18 * published by the Free Software Foundation; either version 2 of the
19 * License, or (at your option) any later version.
20 *
21 * The SLV solver is distributed in hope that it will be
22 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
23 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
24 * General Public License for more details.
25 *
26 * You should have received a copy of the GNU General Public License
27 * along with the program; if not, write to the Free Software Foundation,
28 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
29 * COPYING. COPYING is found in ../compiler.
30 *
31 */
32
33 #include <utilities/ascConfig.h>
34 #include <utilities/ascMalloc.h>
35 #include <general/dstring.h>
36 #include <general/list.h>
37 #include <compiler/compiler.h>
38 #include <compiler/symtab.h>
39 #include <compiler/instance_enum.h>
40 #include <compiler/fractions.h>
41 #include <compiler/module.h>
42 #include <compiler/library.h>
43 #include <compiler/dimen.h>
44 #include <compiler/child.h>
45 #include <compiler/type_desc.h>
46 #include <compiler/atomvalue.h>
47 #include <compiler/parentchild.h>
48 #include <compiler/instquery.h>
49 #include <compiler/instance_io.h>
50 #include "mtx.h"
51 #include "slv_types.h"
52 #include "rel.h"
53 #include "var.h"
54 #include "discrete.h"
55 #include "conditional.h"
56 #include "logrel.h"
57 #include "bnd.h"
58 #include "slv_server.h"
59 #include "slv_common.h"
60 #include "linsol.h"
61 #include "linsolqr.h"
62 #include "slv_client.h"
63
64 /* useful cast */
65 #define IPTR(i) ((struct Instance *)(i))
66
67 /* useful symbol table things to know */
68 #define FIXED_V g_strings[0]
69 #define LOWER_V g_strings[1]
70 #define UPPER_V g_strings[2]
71 #define RELAXED_V g_strings[3]
72 #define NOMINAL_V g_strings[4]
73 #define INTERFACE_V g_strings[5]
74 #define ODEATOL_V g_strings[6]
75
76 /*
77 * array of those symbol table entries we need.
78 */
79 static symchar * g_strings[7];
80
81 SlvBackendToken var_instanceF(const struct var_variable *var)
82 { if (var==NULL || var->ratom==NULL) {
83 FPRINTF(stderr,"var_instance called on bad var\n");
84 return NULL;
85 }
86 return var->ratom;
87 }
88
89 void var_set_instanceF(struct var_variable *var, SlvBackendToken i)
90 {
91 if (var==NULL) {
92 FPRINTF(stderr,"var_set_instance called on NULL var\n");
93 return;
94 }
95 var->ratom = i;
96 }
97
98
99 char *var_make_name(const slv_system_t sys,const struct var_variable *var)
100 {
101 return WriteInstanceNameString(IPTR(var->ratom),IPTR(slv_instance(sys)));
102 }
103
104 char *var_make_xname(const struct var_variable *var)
105 {
106 static char name[81];
107 char *res;
108 sprintf(name,"x%d",var_sindex(var));
109 res=ASC_NEW_ARRAY(char,strlen(name)+1);
110 sprintf(res,"%s",name);
111 return res;
112 }
113
114 void var_write_name(const slv_system_t sys,
115 const struct var_variable *var,FILE *fp)
116 {
117 if (var == NULL || fp==NULL) return;
118 if (sys!=NULL) {
119 WriteInstanceName(fp,var_instance(var),slv_instance(sys));
120 } else {
121 WriteInstanceName(fp,var_instance(var),NULL);
122 }
123 }
124
125 void var_destroy(struct var_variable *var)
126 {
127 if (var==NULL) return;
128 var->ratom = NULL;
129 ascfree((POINTER)var->incidence);
130 }
131
132
133 int32 var_mindexF(const struct var_variable *var)
134 {
135 if (var==NULL || var->ratom==NULL) {
136 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
137 return -1;
138 }
139 return var->mindex;
140 }
141
142 void var_set_mindexF(struct var_variable *var, int32 mindex)
143 {
144 if (var==NULL || var->ratom==NULL) {
145 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
146 return;
147 }
148 var->mindex = mindex;
149 }
150
151 int32 var_sindexF(const struct var_variable *var)
152 {
153 if (var==NULL || var->ratom==NULL) {
154 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
155 return -1;
156 }
157 return var->sindex;
158 }
159
160 void var_set_sindexF(struct var_variable *var, int32 sindex)
161 {
162 if (var==NULL || var->ratom==NULL) {
163 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
164 return;
165 }
166 var->sindex = sindex;
167 }
168
169 real64 var_value(const struct var_variable *var)
170 {
171 if (var==NULL || var->ratom==NULL) {
172 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
173 return 0.0;
174 }
175 return( RealAtomValue(var->ratom) );
176 }
177
178 void var_set_value(struct var_variable *var, real64 value)
179 {
180 if (var==NULL || var->ratom==NULL) {
181 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
182 return;
183 }
184 SetRealAtomValue(var->ratom,value,(unsigned)0);
185 }
186
187 real64 var_nominal(struct var_variable *var)
188 {
189 struct Instance *c;
190 if (var==NULL || var->ratom==NULL) {
191 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
192 return 1.0;
193 }
194 c = ChildByChar(var->ratom,NOMINAL_V);
195 if( c == NULL ) {
196 FPRINTF(ASCERR,"no 'nominal' field in variable");
197 /* WriteInstance(stderr,IPTR(var->ratom)); */
198 return 1.0;
199 }
200 return( RealAtomValue(c) );
201 }
202
203 void var_set_nominal(struct var_variable *var, real64 nominal)
204 {
205 struct Instance *c;
206 if (var==NULL || var->ratom==NULL) {
207 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
208 return;
209 }
210 c = ChildByChar(IPTR(var->ratom),NOMINAL_V);
211 if( c == NULL ) {
212 ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'nominal' field in var");
213 /* WriteInstance(stderr,IPTR(var->ratom)); */
214 return;
215 }
216 SetRealAtomValue(c,nominal,(unsigned)0);
217 }
218
219
220 real64 var_lower_bound(struct var_variable *var)
221 {
222 struct Instance *c;
223 if (var==NULL || var->ratom==NULL) {
224 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
225 return 0.0;
226 }
227 c = ChildByChar(IPTR(var->ratom),LOWER_V);
228 if( c == NULL ) {
229 ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'lower_bound' field");
230 WriteInstance(stderr,IPTR(var->ratom));
231 return 0.0;
232 }
233 return( RealAtomValue(c) );
234 }
235
236 void var_set_lower_bound(struct var_variable *var, real64 lower_bound)
237 {
238 struct Instance *c;
239 if (var==NULL || var->ratom==NULL) {
240 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
241 return;
242 }
243 c = ChildByChar(IPTR(var->ratom),LOWER_V);
244 if( c == NULL ) {
245 ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'lower_bound' field");
246 /* WriteInstance(stderr,IPTR(var->ratom)); */
247 return;
248 }
249 SetRealAtomValue(c,lower_bound,(unsigned)0);
250 }
251
252
253 real64 var_upper_bound(struct var_variable *var)
254 {
255 struct Instance *c;
256 if (var==NULL || var->ratom==NULL) {
257 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
258 return 0.0;
259 }
260 c = ChildByChar(IPTR(var->ratom),UPPER_V);
261 if( c == NULL ) {
262 ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'upper_bound' field");
263 /* WriteInstance(stderr,IPTR(var->ratom)); */
264 return 0.0;
265 }
266 return( RealAtomValue(c) );
267 }
268
269 void var_set_upper_bound(struct var_variable *var, real64 upper_bound)
270 {
271 struct Instance *c;
272 if (var==NULL || var->ratom==NULL) {
273 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
274 return;
275 }
276 c = ChildByChar(IPTR(var->ratom),UPPER_V);
277 if( c == NULL ) {
278 ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'upper_bound' field");
279 /* WriteInstance(stderr,IPTR(var->ratom)); */
280 return;
281 }
282 SetRealAtomValue(c,upper_bound,(unsigned)0);
283 }
284
285 double var_odeatol(struct var_variable *var){
286 struct Instance *c;
287 if(var==NULL||var->ratom==NULL){
288 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
289 return -1;
290 }
291 c = ChildByChar(IPTR(var->ratom),ODEATOL_V);
292 if(c==NULL){
293 ERROR_REPORTER_HERE(ASC_PROG_ERR,"no '%s' field",SCP(ODEATOL_V));
294 return -1;
295 }
296 return RealAtomValue(c);
297 }
298
299
300 uint32 var_flagsF(const struct var_variable *var)
301 {
302 return var->flags;
303 }
304
305 void var_set_flagsF(struct var_variable *var, uint32 flags)
306 {
307 var->flags = flags;
308 }
309
310 uint32 var_fixed(struct var_variable *var)
311 {
312 struct Instance *c;
313 if (var==NULL || var->ratom==NULL) {
314 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
315 return FALSE;
316 }
317 c = ChildByChar(IPTR(var->ratom),FIXED_V);
318 if( c == NULL ) {
319 ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'fixed' field");
320 /* WriteInstance(stderr,IPTR(var->ratom)); */
321 return FALSE;
322 }
323 var_set_flagbit(var,VAR_FIXED,GetBooleanAtomValue(c));
324 return( GetBooleanAtomValue(c) );
325 }
326
327 void var_set_fixed(struct var_variable *var, uint32 fixed)
328 {
329 struct Instance *c;
330 if (var==NULL || var->ratom==NULL) {
331 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
332 return;
333 }
334 c = ChildByChar(IPTR(var->ratom),FIXED_V);
335 if( c == NULL ) {
336 ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'fixed' field");
337 /* WriteInstance(stderr,IPTR(var->ratom)); */
338 return;
339 }
340 SetBooleanAtomValue(c,fixed,(unsigned)0);
341 var_set_flagbit(var,VAR_FIXED,fixed);
342 }
343
344 uint32 var_relaxed(struct var_variable *var)
345 {
346 struct Instance *c;
347 if (var==NULL || var->ratom==NULL) {
348 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
349 return FALSE;
350 }
351 c = ChildByChar((var->ratom),RELAXED_V);
352 if( c == NULL ) {
353 ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'relaxed' field");
354 /* WriteInstance(stderr,(var->ratom)); */
355 return FALSE;
356 }
357 var_set_flagbit(var,VAR_RELAXED,GetBooleanAtomValue(c));
358 return( GetBooleanAtomValue(c) );
359 }
360
361 void var_set_relaxed(struct var_variable *var, uint32 fixed)
362 {
363 struct Instance *c;
364 if (var==NULL || var->ratom==NULL) {
365 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
366 return;
367 }
368 c = ChildByChar(IPTR(var->ratom),RELAXED_V);
369 if( c == NULL ) {
370 ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'relaxed' field");
371 /* WriteInstance(stderr,IPTR(var->ratom)); */
372 return;
373 }
374 SetBooleanAtomValue(c,fixed,(unsigned)0);
375 var_set_flagbit(var,VAR_RELAXED,fixed);
376 }
377
378 uint32 var_interface(struct var_variable *var)
379 {
380 struct Instance *c;
381 if (var==NULL || var->ratom==NULL) {
382 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
383 return FALSE;
384 }
385 c = ChildByChar(IPTR(var->ratom),INTERFACE_V);
386 if( c == NULL ) {
387 ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'interface' field");
388 /* WriteInstance(stderr,IPTR(var->ratom)); */
389 return 0;
390 }
391 var_set_flagbit(var,VAR_INTERFACE,GetBooleanAtomValue(c));
392 return( GetIntegerAtomValue(c) );
393 }
394
395 extern uint32 var_flagbit(const struct var_variable *var,const uint32 one)
396 {
397 if (var==NULL || var->ratom == NULL) {
398 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
399 return 0;
400 }
401 return (var->flags & one);
402 }
403
404 void var_set_flagbit(struct var_variable *var, uint32 field,uint32 one)
405 {
406 if (var==NULL || var->ratom == NULL) {
407 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
408 return;
409 }
410 if (one) {
411 var->flags |= field;
412 } else {
413 var->flags &= ~field;
414 }
415 }
416
417 int32 var_apply_filter(const struct var_variable *var,
418 const var_filter_t *filter
419 ){
420 if (var==NULL || filter==NULL || var->ratom == NULL) {
421 ERROR_REPORTER_HERE(ASC_PROG_ERR,"'%s' miscalled with NULL",__FUNCTION__);
422 return FALSE;
423 }
424 /* AND to mask off irrelevant bits in flags and match value, then compare */
425 return (filter->matchbits & var->flags) == (filter->matchbits & filter->matchvalue);
426 }
427
428 /**
429 Implementation function for var_n_incidences(). Do not call this
430 function directly - use var_n_incidences() instead.
431 */
432 int32 var_n_incidencesF(struct var_variable *var)
433 {
434 if (var!=NULL) return var->n_incidences;
435 ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL var");
436 return 0;
437 }
438
439 void var_set_incidencesF(struct var_variable *var,int32 n,
440 struct rel_relation **i)
441 {
442 if(var!=NULL && n >=0) {
443 if (n && i==NULL) {
444 ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL i");
445 }
446 var->n_incidences = n;
447 var->incidence = i;
448 return;
449 }
450 ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL var, or n < 0");
451 }
452 const struct rel_relation **var_incidence_list( struct var_variable *var)
453 {
454 if (var==NULL) return NULL;
455 return( (const struct rel_relation **)var->incidence );
456 }
457
458 struct rel_relation **var_incidence_list_to_modify( struct var_variable *var)
459 {
460 if (var==NULL) return NULL;
461 return( (struct rel_relation **)var->incidence );
462 }
463
464
465
466 /*
467 * global for use with the push function. Sets the ip to the
468 * value in g_var_tag;
469 * should be using vp instead of a global counter.
470 */
471 static void *g_var_tag = NULL;
472 static void * SetVarTags(struct Instance *i,VOIDPTR vp)
473 {
474 (void)vp;
475 if (i!=NULL && InstanceKind(i)==REAL_ATOM_INST) {
476 return g_var_tag;
477 } else {
478 return NULL;
479 }
480 }
481
482 struct var_variable **var_BackendTokens_to_vars(slv_system_t sys,
483 SlvBackendToken *atoms, int32 len)
484 {
485 int32 i,vartot,vlen,count=0;
486 uint32 apos,ulen;
487 struct var_variable **result;
488 struct var_variable **vlist;
489 struct gl_list_t *oldips;
490 if (sys==NULL || atoms == NULL || len < 1) {
491 return NULL;
492 }
493 ulen = (uint32)len;
494 result = (struct var_variable **)malloc(len*sizeof(struct var_variable *));
495 if (result == NULL) return result;
496 /* init results to null */
497 for (i=0; i<len; i++) result[i] = NULL;
498 /* fill ips w/len in all the vars in tree. */
499 g_var_tag = (void *)len;
500 vartot = slv_get_num_master_vars(sys) +
501 slv_get_num_master_pars(sys) +
502 slv_get_num_master_unattached(sys);
503 oldips = PushInterfacePtrs(slv_instance(sys),SetVarTags,vartot,0,NULL);
504 /* fill ips of wanted atoms with i */
505 for (i=0; i<len; i++) {
506 if (GetInterfacePtr(atoms[i])==g_var_tag &&
507 InstanceKind(atoms[i]) == REAL_ATOM_INST) {
508 /* guard a little */
509 SetInterfacePtr((struct Instance *)atoms[i],(void *)i);
510 } else {
511 /* the odds of g_var_tag being a legal pointer are vanishingly
512 small, so if we find an ATOM without g_var_tag we assume it
513 is outside the tree and shouldn't have been in the list. */
514 ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad token");
515 }
516 }
517 /* run through the master lists and put the vars with their atoms */
518 vlist = slv_get_master_var_list(sys);
519 vlen = slv_get_num_master_vars(sys);
520 for (i = 0; i <vlen; i++) {
521 apos = (uint32)GetInterfacePtr(var_instance(vlist[i]));
522 if ( apos < ulen ) {
523 result[apos] = vlist[i];
524 count++;
525 }
526 }
527 vlist = slv_get_master_par_list(sys);
528 vlen = slv_get_num_master_pars(sys);
529 for (i = 0; i <vlen; i++) {
530 apos = (uint32)GetInterfacePtr(var_instance(vlist[i]));
531 if ( apos < ulen ) {
532 result[apos] = vlist[i];
533 count++;
534 }
535 }
536 vlist = slv_get_master_unattached_list(sys);
537 vlen = slv_get_num_master_unattached(sys);
538 for (i = 0; i <vlen; i++) {
539 apos = (uint32)GetInterfacePtr(var_instance(vlist[i]));
540 if ( apos < ulen ) {
541 result[apos] = vlist[i];
542 count++;
543 }
544 }
545 if (count < len) {
546 ERROR_REPORTER_HERE(ASC_PROG_ERR,"found less than expected vars (len = %d, found = %d)",len,count);
547 } else {
548 ERROR_REPORTER_HERE(ASC_PROG_ERR,"found more than expected vars (len = %d, found = %d)",len,count);
549 }
550 PopInterfacePtrs(oldips,NULL,NULL);
551 return result;
552 }
553
554 static struct TypeDescription *g_solver_var_type;
555 static struct TypeDescription *g_solver_int_type;
556 static struct TypeDescription *g_solver_binary_type;
557 static struct TypeDescription *g_solver_semi_type;
558
559 boolean set_solver_types(void) {
560 boolean nerr = 0;
561 if( (g_solver_var_type = FindType(AddSymbol(SOLVER_VAR_STR))) == NULL ) {
562 ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_var' not defined");
563 nerr++;
564 }
565 if( (g_solver_int_type = FindType(AddSymbol(SOLVER_INT_STR))) == NULL ) {
566 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"'solver_int' not defined: MPS will not work");
567 nerr++;
568 }
569 g_solver_binary_type = FindType(AddSymbol(SOLVER_BINARY_STR));
570 if( g_solver_binary_type == NULL) {
571 ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_binary' not defined: MPS will not work");
572 nerr++;
573 }
574 if( (g_solver_semi_type = FindType(AddSymbol(SOLVER_SEMI_STR))) == NULL ) {
575 ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_semi' not defined: MPS will not work");
576 nerr++;
577 }
578
579 LOWER_V = AddSymbolL("lower_bound",11);
580 UPPER_V = AddSymbolL("upper_bound",11);
581 RELAXED_V = AddSymbolL("relaxed",7);
582 NOMINAL_V = AddSymbolL("nominal",7);
583 FIXED_V = AddSymbolL("fixed",5);
584 INTERFACE_V = AddSymbolL("interface",9);
585 ODEATOL_V = AddSymbol("ode_atol");
586 return nerr;
587 }
588
589 boolean solver_var( SlvBackendToken inst)
590 {
591 struct TypeDescription *type;
592
593 if (!g_solver_var_type) return FALSE;
594 type = InstanceTypeDesc(IPTR(inst));
595 return( type == MoreRefined(type,g_solver_var_type) );
596 }
597
598 boolean solver_int( SlvBackendToken inst)
599 {
600 struct TypeDescription *type;
601
602 if (!g_solver_int_type) return FALSE;
603 type = InstanceTypeDesc(IPTR(inst));
604 return( type == MoreRefined(type,g_solver_int_type) );
605 }
606
607 boolean solver_binary( SlvBackendToken inst)
608 {
609 struct TypeDescription *type;
610
611 if (!g_solver_binary_type) return FALSE;
612 type = InstanceTypeDesc(IPTR(inst));
613 return( type == MoreRefined(type,g_solver_binary_type) );
614 }
615
616 boolean solver_semi( SlvBackendToken inst)
617 {
618 struct TypeDescription *type;
619
620 if (!g_solver_semi_type) return FALSE;
621 type = InstanceTypeDesc(IPTR(inst));
622 return( type == MoreRefined(type,g_solver_semi_type) );
623 }
624

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