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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 199 - (show annotations) (download) (as text)
Sat Jan 21 02:23:55 2006 UTC (18 years, 5 months ago) by johnpye
File MIME type: text/x-csrc
File size: 45469 byte(s)
Finished adding macros in slv.c.
1 /*
2 SLV: Ascend Nonlinear Solver
3 Copyright (C) 1990 Karl Michael Westerberg
4 Copyright (C) 1993 Joseph Zaher
5 Copyright (C) 1994 Joseph Zaher, Benjamin Andrew Allan
6 Copyright (C) 1996 Benjamin Andrew Allan
7 Copyright (C) 2005-2006 Carnegie-Mellon University
8
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
13
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
22 This file is part of the SLV solver.
23 */
24
25 #include <math.h>
26 #include <stdarg.h>
27 #include "utilities/ascConfig.h"
28 #include "compiler/instance_enum.h"
29 #include "compiler/fractions.h"
30 #include "compiler/compiler.h"
31 #include "utilities/ascMalloc.h"
32 #include "utilities/ascPanic.h"
33 #include "compiler/dimen.h"
34 #include "compiler/atomvalue.h"
35 #include "solver/mtx.h"
36 #include "solver/linsol.h"
37 #include "solver/linsolqr.h"
38 #include "solver/slv_types.h"
39 #include "solver/var.h"
40 #include "solver/rel.h"
41 #include "solver/logrel.h"
42 #include "solver/discrete.h"
43 #include "solver/conditional.h"
44 #include "solver/bnd.h"
45 #include "solver/bndman.h"
46 #include "solver/system.h"
47 #include "solver/slv_server.h"
48 #include "solver/slv_common.h"
49 #include "solver/slv_client.h"
50 #include "solver/analyze.h"
51
52 #define NEEDSTOBEDONE 0
53
54 /**
55 *** Include all of the solvers involved,
56 *** even if they are not linked later
57 *** Defines are to take care of the unlinked ones.
58 **/
59 #if 0
60 # include "solver/slv0.h"
61 # include "solver/slv1.h"
62 # include "solver/slv2.h"
63 # include "solver/slv3.h"
64 # include "solver/slv4.h"
65 # include "solver/slv5.h"
66 # include "solver/slv6.h"
67 # include "solver/slv7.h"
68 # include "solver/slv8.h"
69 # include "solver/slv9.h"
70 #endif
71
72
73 struct slv_system_structure {
74 int solver;
75
76 int serial_id;
77 /**< Through time, two systems may have the same pointer but never
78 simultaneously. The serial_id provides a unique tag that will
79 never repeat. Clients concerned with identity but not capable
80 of tracking time must use the serial_id for checks. */
81
82 SlvBackendToken instance; /* should be void * in the most generic case */
83
84 /* All solver handles. sysI can't be dereferenced outside slvI.c
85 * should be an array of pointers to arrays of the functions provided
86 * by dynamically loaded clients, or at least by the client which this
87 * system is currently supporting.
88 */
89
90 SlvClientToken ct;
91 /* This is a pointer that the client returns on registration.
92 * If it is not null, the registration was successful.
93 * This token will be handed back to the client code on all calls
94 * originating from here.
95 */
96
97 dof_t dof; /* non linear blocks */
98 dof_t logdof; /* logical blocks */
99
100 /* In the following NULL terminated lists, note that snum and mnum
101 * are the lengths of the arrays WITHOUT the NULL pointer at the end.
102 * Note objs is a list of relations that are objectives
103 * (e_maximize,e_minimize). this list will include the first included obj.
104 */
105 struct {
106 int snum; /* length of the solver list */
107 int mnum; /* length of the master list */
108 struct var_variable **solver;
109 struct var_variable **master;
110 } vars;
111
112 struct {
113 int snum; /* length of the solver list */
114 int mnum; /* length of the master list */
115 struct dis_discrete **solver;
116 struct dis_discrete **master;
117 } dvars;
118
119 struct {
120 int snum; /* length of the solver list */
121 int mnum; /* length of the master list */
122 struct rel_relation **solver;
123 struct rel_relation **master;
124 } rels;
125
126 struct {
127 int snum;
128 int mnum;
129 struct rel_relation **solver;
130 struct rel_relation **master;
131 } objs;
132
133 struct {
134 int snum; /* length of the solver list */
135 int mnum; /* length of the master list */
136 struct rel_relation **solver;
137 struct rel_relation **master;
138 } condrels;
139
140 struct {
141 int snum; /* length of the solver list */
142 int mnum; /* length of the master list */
143 struct logrel_relation **solver;
144 struct logrel_relation **master;
145 } logrels;
146
147 struct {
148 int snum; /* length of the solver list */
149 int mnum; /* length of the master list */
150 struct logrel_relation **solver;
151 struct logrel_relation **master;
152 } condlogrels;
153
154 struct {
155 int snum; /* length of the solver list */
156 int mnum; /* length of the master list */
157 struct w_when **solver;
158 struct w_when **master;
159 } whens;
160
161 struct {
162 int snum; /* length of the solver list */
163 int mnum; /* length of the master list */
164 struct bnd_boundary **solver;
165 struct bnd_boundary **master;
166 } bnds;
167
168 struct {
169 int snum;
170 int mnum;
171 struct var_variable **solver;
172 struct var_variable **master;
173 } pars;
174
175 struct {
176 int snum;
177 int mnum;
178 struct var_variable **solver;
179 struct var_variable **master;
180 } unattached;
181
182 struct {
183 int snum;
184 int mnum;
185 struct dis_discrete **solver;
186 struct dis_discrete **master;
187 } disunatt;
188
189 /* the data that follows is for internal consumption only. */
190 struct {
191 int num_extrels;
192 struct ExtRelCache **erlist;
193 } extrels;
194
195 struct rel_relation *obj; /* selected for optimization from list */
196 struct var_variable *objvar; /* selected for optimization from list */
197 struct gl_list_t *symbollist; /* list of symbol values struct used to */
198 /* assign an integer value to a symbol value */
199 struct {
200 /** @TODO move the 'bufs' into the above structs (disunatt, etc) */
201 struct var_variable *ubuf; /* data space for unclassified real ATOMs */
202 struct dis_discrete *udbuf; /* data space for unclassified discrete ATOM */
203 struct var_variable *pbuf; /* data space for real ATOMs that are pars */
204 struct var_variable *vbuf; /* data space for real ATOMs that are vars */
205 struct dis_discrete *dbuf; /* data space for discrete ATOMs that are vars*/
206 struct rel_relation *rbuf; /* data space for real rel constraints */
207 struct rel_relation *cbuf; /* data space for conditional rel */
208 struct rel_relation *obuf; /* data space for real relation objectives */
209 struct logrel_relation *lbuf; /* data space for logical rel */
210 struct logrel_relation *clbuf; /* data space for conditional logical rel*/
211 struct w_when *wbuf; /* data space for whens */
212 struct bnd_boundary *bbuf; /* data space for boundaries */
213 struct var_variable **incidence; /* all relation incidence list memory */
214 struct rel_relation **varincidence; /* all variable incidence list memory */
215 struct dis_discrete **logincidence; /* all logrel incidence list memory */
216 long incsize; /* size of incidence array */
217 long varincsize; /* size of varincidence array */
218 long logincsize; /* size of discrete incidence array */
219 #if NEEDSTOBEDONE
220 /* we should be group allocating this data, but aren't */
221 struct ExtRelCache *ebuf; /* data space for all extrel caches */
222 #endif
223 } data;
224
225 int32 nmodels;
226 int32 need_consistency; /* consistency analysis required for conditional model ? */
227 real64 objvargrad; /* maximize -1 minimize 1 noobjvar 0 */
228 };
229
230 /**
231 global variable used to communicate information between solvers and
232 an interface, whether a calculation should be halted or not.
233 0 means go on. any other value may contain additional information
234 content.
235 */
236 int Solv_C_CheckHalt_Flag = 0;
237
238 int g_SlvNumberOfRegisteredClients; /* see header */
239
240 /** making ANSI assumption that RegisteredClients is init to 0/NULLs */
241 static SlvFunctionsT SlvClientsData[SLVMAXCLIENTS];
242
243 /*-----------------------------------------------------------------*/
244 /**
245 Note about g_number_of_whens, g_number_of_dvars and g_number_of_bnds:
246 These numbers are as the same as those given in the solver and master
247 lists, however, these lists are destroyed before the buffers are destroyed,
248 so the information is gone before I can use it.
249 */
250
251 /** Global var used to destroy the cases and the gl_list inside each WHEN */
252 static int g_number_of_whens;
253
254 /** Global var used to destroy the list of whens in each discrete variable */
255 static int g_number_of_dvars;
256
257 /** Global var used to destroy the list of logical relations in each boundary */
258 static int g_number_of_bnds;
259
260 /*-------------------------------------------------------------------
261 A bunch of annoyingly unintuitive macros that probably will save
262 you from developing RSI :-)
263 */
264
265 /** Return the solver index for a given slv_system_t */
266 #define SNUM(sys) ((sys)->solver)
267
268 /** Number of registered clients */
269 #define NORC g_SlvNumberOfRegisteredClients
270
271 /** Return the pointer to a registered SLV client's data space. @see SF, related.
272 @param i registered solver ID
273 */
274 #define SCD(i) SlvClientsData[(i)]
275
276 /** Get the solver index for a system and return TRUE if the solver
277 index is in the range [0,NORC). 'sys' should not be null
278 @param sys system, slv_system_t.
279 */
280 #define LS(sys) ( (sys)->solver >= 0 && (sys)->solver < g_SlvNumberOfRegisteredClients )
281
282 /** Boolean test that i is in the range [0,NORC) */
283 #define LSI(i) ( (i) >= 0 && (i) < g_SlvNumberOfRegisteredClients )
284
285 /** Check and return a function pointer. See @SF */
286 #define CF(sys,ptr) ( LS(sys) ? SlvClientsData[(sys)->solver].ptr : NULL )
287
288 /** Return the pointer to the client-supplied function or char if
289 the client supplied one, else NULL. This should only be called
290 with nonNULL sys after CF is happy. @see CF
291 */
292 #define SF(sys,ptr) ( SlvClientsData[(sys)->solver].ptr )
293
294 /** Free a pointer provided it's not NULL */
295 #define SFUN(p) if ((p) != NULL) ascfree(p)
296
297 /*-----------------------------------------------------------------
298 SERVER FUNCTIONS
299 */
300
301 int slv_lookup_client( const char *solverName )
302 {
303 int i;
304 if (solverName == NULL) { return -1; }
305 for (i = 0; i < NORC; i++) {
306 if ( strcmp( SCD(i).name, solverName)==0) {
307 return i;
308 }
309 }
310 return -1;
311 }
312
313 /** Register a new solver.
314 @TODO This needs work still, particularly of the dynamic loading
315 sort. it would be good if here we farmed out the dynamic loading
316 to another file so we don't have to crap this one all up.
317 */
318 int slv_register_client(SlvRegistration registerfunc, CONST char *func
319 ,CONST char *file, int *new_client_id)
320 {
321 int status;
322
323 (void)func; /* stop gcc whine about unused parameter */
324 (void)file; /* stop gcc whine about unused parameter */
325
326 status = registerfunc(&( SlvClientsData[NORC]));
327 if (!status) { /* ok */
328 SlvClientsData[NORC].number = NORC;
329 *new_client_id = NORC;
330 NORC++;
331 } else {
332 *new_client_id = -2;
333 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"Client %d registration failure (%d)!\n",NORC,status);
334 }
335 return status;
336 }
337
338 slv_system_t slv_create(void)
339 {
340 slv_system_t sys;
341 static unsigned nextid = 1;
342 sys = (slv_system_t)asccalloc(1,sizeof(struct slv_system_structure) );
343 /* all lists, sizes, pointers DEFAULT to 0/NULL */
344 sys->solver = -1; /* a nonregistration */
345 sys->serial_id = nextid++;
346 return(sys);
347 }
348
349 unsigned slv_serial_id(slv_system_t sys)
350 {
351 return sys->serial_id;
352 }
353
354 /*----------------------------------------------------
355 destructors
356 */
357 static
358 void slv_destroy_dvar_buffer(struct dis_discrete *dbuf)
359 {
360 int c;
361 struct dis_discrete *cur_dis;
362 for (c=0;c<g_number_of_dvars;c++){
363 cur_dis = &(dbuf[c]);
364 dis_destroy(cur_dis);
365 }
366 ascfree(dbuf);
367 }
368
369 static
370 void slv_destroy_when_buffer(struct w_when *wbuf)
371 {
372 int c;
373 struct w_when *cur_when;
374 for (c=0;c<g_number_of_whens;c++){
375 cur_when = &(wbuf[c]);
376 when_destroy(cur_when);
377 }
378 ascfree(wbuf);
379 }
380
381 static
382 void slv_destroy_bnd_buffer(struct bnd_boundary *bbuf)
383 {
384 int c;
385 struct bnd_boundary *cur_bnd;
386 for (c=0;c<g_number_of_bnds;c++){
387 cur_bnd = &(bbuf[c]);
388 bnd_destroy(cur_bnd);
389 }
390 ascfree(bbuf);
391 }
392
393 int slv_destroy(slv_system_t sys)
394 {
395 int ret = 0;
396 if (sys->ct != NULL) {
397 if ( CF(sys,cdestroy) == NULL ) {
398 ERROR_REPORTER_HERE(ASC_PROG_FATAL,"slv_destroy: SlvClientToken 0x%p not freed by %s",
399 sys->ct,SF(sys,name));
400 } else {
401 if ( SF(sys,cdestroy)(sys,sys->ct) ) {
402 ret++;
403 }
404 }
405 }
406 if (ret) {
407 ERROR_REPORTER_HERE(ASC_PROG_FATAL,"slv_destroy: slv_system_t 0x%p not freed.",sys);
408 } else {
409 if (sys->data.ubuf != NULL) ascfree(sys->data.ubuf);
410 sys->data.ubuf = NULL;
411 if (sys->data.udbuf != NULL) ascfree(sys->data.udbuf);
412 sys->data.udbuf = NULL;
413 if (sys->data.pbuf != NULL) ascfree(sys->data.pbuf);
414 sys->data.pbuf = NULL;
415 if (sys->data.vbuf != NULL) ascfree(sys->data.vbuf);
416 sys->data.vbuf = NULL;
417 if (sys->data.dbuf != NULL) {
418 slv_destroy_dvar_buffer(sys->data.dbuf);
419 sys->data.dbuf = NULL;
420 }
421 if (sys->data.rbuf != NULL) ascfree(sys->data.rbuf);
422 sys->data.rbuf = NULL;
423 if (sys->data.cbuf != NULL) ascfree(sys->data.cbuf);
424 sys->data.cbuf = NULL;
425 if (sys->data.obuf != NULL) ascfree(sys->data.obuf);
426 sys->data.obuf = NULL;
427 if (sys->data.lbuf != NULL) ascfree(sys->data.lbuf);
428 sys->data.lbuf = NULL;
429 if (sys->data.clbuf != NULL) ascfree(sys->data.clbuf);
430 sys->data.clbuf = NULL;
431 if (sys->data.wbuf != NULL) {
432 slv_destroy_when_buffer(sys->data.wbuf);
433 sys->data.wbuf = NULL;
434 }
435 if (sys->data.bbuf != NULL) {
436 slv_destroy_bnd_buffer(sys->data.bbuf);
437 sys->data.bbuf = NULL;
438 }
439 if (sys->data.incidence != NULL) ascfree(sys->data.incidence);
440 sys->data.incidence = NULL;
441 if (sys->data.varincidence != NULL) ascfree(sys->data.varincidence);
442 sys->data.varincidence = NULL;
443 if (sys->data.logincidence != NULL) ascfree(sys->data.logincidence);
444 sys->data.incidence = NULL;
445 ascfree( (POINTER)sys );
446 }
447 return ret;
448 }
449
450 void slv_destroy_client(slv_system_t sys)
451 {
452
453 if (sys->ct != NULL) {
454 if ( CF(sys,cdestroy) == NULL ) {
455 ERROR_REPORTER_HERE(ASC_PROG_ERR,
456 "SlvClientToken 0x%p not freed in slv_destroy_client",sys->ct);
457 } else {
458 if ( SF(sys,cdestroy)(sys,sys->ct) ) {
459 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_destroy_client: SlvClientToken not freed");
460 } else {
461 sys->ct = NULL;
462 }
463 }
464 }
465 }
466
467 /*---------------------------------------------------------
468 get/set instance
469 */
470
471 SlvBackendToken slv_instance(slv_system_t sys)
472 {
473 if (sys == NULL) {
474 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_instance: called with NULL system.");
475 return NULL;
476 } else {
477 return sys->instance;
478 }
479 }
480
481 void slv_set_instance(slv_system_t sys,SlvBackendToken instance)
482 {
483 if (sys == NULL) {
484 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_set_instance: called with NULL system.");
485 return;
486 } else {
487 sys->instance = instance;
488 }
489 }
490
491 dof_t *slv_get_dofdata(slv_system_t sys)
492 {
493 return &(sys->dof);
494 }
495
496 dof_t *slv_get_log_dofdata(slv_system_t sys)
497 {
498 return &(sys->logdof);
499 }
500
501 int32 slv_get_num_models(slv_system_t sys)
502 {
503 if (sys == NULL) {
504 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_get_num_models: called with NULL system.");
505 return 0;
506 } else {
507 return sys->nmodels;
508 }
509 }
510 void slv_set_num_models(slv_system_t sys, int32 nmod)
511 {
512 if (sys == NULL) {
513 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_set_num_models: called with NULL system.");
514 } else {
515 sys->nmodels = nmod;
516 }
517 }
518
519
520 void slv_set_symbol_list(slv_system_t sys,
521 struct gl_list_t *sv)
522 {
523 if (sys->symbollist != NULL) {
524 DestroySymbolValuesList(sys->symbollist);
525 }
526 sys->symbollist = sv;
527 }
528
529 /*--------------------------------------------------------]
530 Macros to declare
531
532 slv_set_master_*_list(slv_system_t sys, string var_variable **list, int size)
533 slv_set_*_buf(slv_system_t sys, string var_variable **list, int size)
534 */
535
536 #define DEFINE_SET_MASTER_LIST_METHOD(NAME,PROP,TYPE) \
537 void slv_set_master_##NAME##_list(slv_system_t sys, struct TYPE **vlist, int size){ \
538 SFUN(sys->PROP.master); \
539 sys->PROP.mnum = size; \
540 sys->PROP.master = vlist; \
541 }
542
543
544
545 #define DEFINE_SET_MASTER_LIST_METHODS(D) \
546 D(var,vars,var_variable) \
547 D(par,pars,var_variable) \
548 D(unattached,unattached,var_variable); \
549 D(dvar,dvars,dis_discrete) \
550 D(disunatt,disunatt,dis_discrete) \
551 D(rel,rels,rel_relation) \
552 D(condrel,condrels,rel_relation) \
553 D(obj,objs,rel_relation) \
554 D(logrel,logrels,logrel_relation) \
555 D(condlogrel,condlogrels,logrel_relation) \
556 D(when,whens,w_when) \
557 D(bnd,bnds,bnd_boundary)
558
559 DEFINE_SET_MASTER_LIST_METHODS(DEFINE_SET_MASTER_LIST_METHOD)
560
561 /*------------------------------------------------------------
562 Macros to declare
563
564 slv_set_NAME_buf(slv_system_t sts, struct TYPE *PROP)
565 */
566
567 #define DEFINE_SET_BUF_METHOD(NAME,PROP,TYPE) \
568 void slv_set_##NAME##_buf(slv_system_t sys, struct TYPE *PROP){ \
569 if(sys->data.PROP !=NULL ){ \
570 Asc_Panic(2,"slv_set_" #NAME "_buf","bad call."); \
571 }else{ \
572 sys->data.PROP = PROP; \
573 } \
574 }
575
576 #define DEFINE_SET_BUF_METHODS(D) \
577 D(var,vbuf,var_variable) \
578 D(par,pbuf,var_variable) \
579 D(unattached,ubuf,var_variable) \
580 D(disunatt,udbuf,dis_discrete) \
581 D(rel,rbuf,rel_relation) \
582 D(condrel,cbuf,rel_relation) \
583 D(obj,obuf,rel_relation) \
584 D(logrel,lbuf,logrel_relation) \
585 D(condlogrel,clbuf,logrel_relation)
586
587 DEFINE_SET_BUF_METHODS(DEFINE_SET_BUF_METHOD)
588
589 /*
590 Before the following can be placed into the above macro, the globals
591 g_number_of_dvars
592 g_number_of_whens
593 g_number_of_bnds
594 need to be eliminated. They should be entered as properties of the 'sys', presumably?
595 */
596
597 void slv_set_dvar_buf(slv_system_t sys, struct dis_discrete *dbuf, int len)
598 {
599 if (sys->data.dbuf !=NULL ) {
600 Asc_Panic(2,"slv_set_dvar_buf",
601 "bad call.");
602 } else {
603 sys->data.dbuf = dbuf;
604 g_number_of_dvars = len;
605 }
606 }
607
608 void slv_set_when_buf(slv_system_t sys, struct w_when *wbuf, int len)
609 {
610 if (sys->data.wbuf !=NULL ) {
611 Asc_Panic(2,"slv_set_when_buf","bad call.");
612 } else {
613 sys->data.wbuf = wbuf;
614 g_number_of_whens = len;
615 }
616 }
617
618 void slv_set_bnd_buf(slv_system_t sys, struct bnd_boundary *bbuf, int len)
619 {
620 if (sys->data.bbuf !=NULL ) {
621 Asc_Panic(2,"slv_set_bnd_buf",
622 "bad call.");
623 } else {
624 sys->data.bbuf = bbuf;
625 g_number_of_bnds = len;
626 }
627 }
628
629 /*---------------------------------------------------------------*/
630
631 void slv_set_incidence(slv_system_t sys, struct var_variable **incidence,long s)
632 {
633 if (sys->data.incidence !=NULL || incidence == NULL) {
634 Asc_Panic(2,"slv_set_incidence",
635 "bad call.");
636 } else {
637 sys->data.incidence = incidence;
638 sys->data.incsize = s;
639 }
640 }
641
642 void slv_set_var_incidence(slv_system_t sys, struct rel_relation **varincidence,long s)
643 {
644 if (sys->data.varincidence !=NULL || varincidence == NULL) {
645 Asc_Panic(2,"slv_set_varincidence",
646 "bad call.");
647 } else {
648 sys->data.varincidence = varincidence;
649 sys->data.varincsize = s;
650 }
651 }
652
653 void slv_set_logincidence(slv_system_t sys, struct dis_discrete **logincidence,long s)
654 {
655 if (sys->data.logincidence !=NULL) {
656 Asc_Panic(2,"slv_set_logincidence","bad call.");
657 } else {
658 sys->data.logincidence = logincidence;
659 sys->data.incsize = s;
660 }
661 }
662
663 void slv_set_extrel_list(slv_system_t sys,struct ExtRelCache **erlist,
664 int size)
665 {
666 if (sys->extrels.erlist !=NULL ) {
667 Asc_Panic(2,"slv_set_extrel_list",
668 "bad call.");
669 }
670 sys->extrels.num_extrels = size;
671 sys->extrels.erlist = erlist;
672 }
673
674 struct ExtRelCache **slv_get_extrel_list(slv_system_t sys)
675 {
676 return sys->extrels.erlist;
677 }
678
679 int slv_get_num_extrels(slv_system_t sys)
680 {
681 return sys->extrels.num_extrels;
682 }
683
684
685 /*********************************************************************\
686 client functions.
687 \*********************************************************************/
688 int Solv_C_CheckHalt()
689 {
690 if (Solv_C_CheckHalt_Flag)
691 return 1;
692 else
693 return 0;
694 }
695
696 const char *slv_solver_name(int index)
697 {
698 static char errname[] = "ErrorSolver";
699 if (index >= 0 && index < NORC) {
700 if ( SlvClientsData[index].name == NULL ) {
701 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_solver_name: unnamed solver: index='%d'",index);
702 return errname;
703 } else {
704 return SlvClientsData[index].name;
705 }
706 } else {
707 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_solver_name: invalid solver index '%d'", index);
708 return errname;
709 }
710 }
711
712 const mtx_block_t *slv_get_solvers_blocks(slv_system_t sys)
713 {
714 if (sys == NULL) {
715 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_solvers_blocks called with NULL system");
716 return NULL;
717 } else {
718 return &(sys->dof.blocks);
719 }
720 }
721
722 const mtx_block_t *slv_get_solvers_log_blocks(slv_system_t sys)
723 {
724 if (sys == NULL) {
725 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_solvers_log_blocks called with NULL system");
726 return NULL;
727 } else {
728 return &(sys->logdof.blocks);
729 }
730 }
731
732 void slv_set_solvers_blocks(slv_system_t sys,int len, mtx_region_t *data)
733 {
734 if (sys == NULL || len < 0) {
735 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solvers_blocks called with NULL system or bad len.\n");
736 } else {
737 if (len && data==NULL) {
738 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solvers_blocks called with bad data.\n");
739 } else {
740 if (sys->dof.blocks.nblocks && sys->dof.blocks.block != NULL) {
741 ascfree(sys->dof.blocks.block);
742 }
743 sys->dof.blocks.block = data;
744 sys->dof.blocks.nblocks = len;
745 }
746 }
747 }
748
749 void slv_set_solvers_log_blocks(slv_system_t sys,int len, mtx_region_t *data)
750 {
751 if (sys == NULL || len < 0) {
752 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solvers_log_blocks called with NULL system or bad len\n");
753 } else {
754 if (len && data==NULL) {
755 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solvers_log_blocks called with bad data.\n");
756 } else {
757 if (sys->logdof.blocks.nblocks && sys->logdof.blocks.block != NULL) {
758 ascfree(sys->logdof.blocks.block);
759 }
760 sys->logdof.blocks.block = data;
761 sys->logdof.blocks.nblocks = len;
762 }
763 }
764 }
765
766 void slv_check_var_initialization(slv_system_t sys){
767 struct var_variable **vp;
768 for (vp = slv_get_solvers_var_list(sys); *vp != NULL; vp++) {
769 if (!AtomAssigned((struct Instance *)var_instance(*vp))) {
770 var_set_value(*vp,var_nominal(*vp));
771 }
772 }
773 }
774
775 void slv_check_dvar_initialization(slv_system_t sys)
776 {
777 struct dis_discrete **vp;
778
779 for (vp = slv_get_solvers_dvar_list(sys); *vp != NULL; vp++) {
780 if (!AtomAssigned((struct Instance *)dis_instance(*vp))) {
781 dis_set_boolean_value(*vp,1);
782 }
783 }
784 }
785
786
787 void slv_bnd_initialization(slv_system_t sys)
788 {
789 struct bnd_boundary **bp;
790 int32 value;
791
792 for (bp = slv_get_solvers_bnd_list(sys); *bp != NULL; bp++) {
793 value = bndman_calc_satisfied(*bp);
794 bnd_set_cur_status(*bp,value);
795 bnd_set_pre_status(*bp,value);
796 bnd_set_crossed(*bp,FALSE);
797 if (bnd_kind(*bp) == e_bnd_rel) {
798 value = bndman_calc_at_zero(*bp);
799 bnd_set_at_zero(*bp,value);
800 } else {
801 bnd_set_at_zero(*bp,FALSE);
802 }
803 }
804 }
805
806 struct gl_list_t *slv_get_symbol_list(slv_system_t sys)
807 {
808 if (sys==NULL) {
809 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_symbol_list called with NULL system.\n");
810 return NULL;
811 }
812 return sys->symbollist;
813 }
814
815 /*---------------------------------------------------------
816 Macros to define
817
818 slv_set_solvers_*_list
819 slv_get_solvers_*_list
820 slv_get_master_*_list
821 */
822 #define DEFINE_SET_SOLVERS_LIST_METHOD(NAME,PROP,TYPE) \
823 void slv_set_solvers_##NAME##_list(slv_system_t sys, struct TYPE **vlist, int size){ \
824 if(sys->PROP.master==NULL){ \
825 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"slv_set_solvers_" #NAME "_list: called before slv_set_master_" #NAME "_list."); \
826 /* might be ok, no return */ \
827 } \
828 sys->PROP.snum = size; \
829 sys->PROP.solver = vlist; \
830 }
831
832 #define DEFINE_SET_SOLVERS_LIST_METHOD_RETURN(NAME,PROP,TYPE) \
833 void slv_set_solvers_##NAME##_list(slv_system_t sys, struct TYPE **vlist, int size){ \
834 if(sys->PROP.master==NULL){ \
835 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"slv_set_solvers_" #NAME "_list: called before slv_set_master_" #NAME "_list."); \
836 return; /* can't be OK, so return now */ \
837 } \
838 sys->PROP.snum = size; \
839 sys->PROP.solver = vlist; \
840 }
841
842 #define DEFINE_GET_SOLVERS_LIST_METHOD(NAME,PROP,TYPE) \
843 struct TYPE **slv_get_solvers_##NAME##_list(slv_system_t sys){ \
844 if (sys->PROP.solver == NULL) { \
845 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_solvers_" #NAME "_list: returning NULL (?)."); \
846 } \
847 return sys->PROP.solver; \
848 }
849
850 #define DEFINE_GETSET_LIST_METHODS(D,D_RETURN) \
851 D_RETURN(var,vars,var_variable) \
852 D(par,pars,var_variable) \
853 D(unattached,unattached,var_variable) \
854 D_RETURN(dvar,dvars,dis_discrete) \
855 D(disunatt,disunatt,dis_discrete) \
856 D_RETURN(rel,rels,rel_relation) \
857 D_RETURN(obj,objs,rel_relation) \
858 D_RETURN(condrel,condrels,rel_relation) \
859 D_RETURN(logrel,logrels,logrel_relation) \
860 D_RETURN(condlogrel,condlogrels,logrel_relation) \
861 D_RETURN(when,whens,w_when) \
862 D_RETURN(bnd,bnds,bnd_boundary)
863
864 /* the slv_set_solvers_*_list methods: some have a 'return' when sys->PROP.master==NULL; others do not: */
865 DEFINE_GETSET_LIST_METHODS(DEFINE_SET_SOLVERS_LIST_METHOD, DEFINE_SET_SOLVERS_LIST_METHOD_RETURN)
866
867 /* the slv_get_solvers_*_list methods: all have the same form so it's DEFINE...(D,D) in this case: */
868 DEFINE_GETSET_LIST_METHODS(DEFINE_GET_SOLVERS_LIST_METHOD, DEFINE_GET_SOLVERS_LIST_METHOD)
869
870 #define DEFINE_GET_MASTER_LIST_METHOD(NAME,PROP,TYPE) \
871 struct TYPE **slv_get_master_##NAME##_list(slv_system_t sys){ \
872 if (sys->PROP.master == NULL) { \
873 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_master_" #NAME "_list returning NULL?\n"); \
874 } \
875 return sys->PROP.master; \
876 }
877
878 /* the slv_get_master_*_list are also all of the same form, so DEFINE...(D,D) */
879 DEFINE_GETSET_LIST_METHODS(DEFINE_GET_MASTER_LIST_METHOD,DEFINE_GET_MASTER_LIST_METHOD)
880
881 /*----------------------------------------------------------------------
882 Macros to define:
883
884 slv_get_num_solvers_TYPE
885 slv_get_num_master_TYPE
886 */
887
888 #define DEFINE_SOLVERS_GET_NUM_METHOD(TYPE) \
889 int slv_get_num_solvers_##TYPE(slv_system_t sys){ \
890 if(sys==NULL){ \
891 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"slv_get_num_solvers_" #TYPE " called with NULL system."); \
892 return 0; \
893 } \
894 return sys->TYPE.snum; \
895 }
896
897 #define DEFINE_MASTER_GET_NUM_METHOD(TYPE) \
898 int slv_get_num_master_##TYPE(slv_system_t sys){ \
899 if(sys==NULL){ \
900 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"slv_get_num_master_" #TYPE " called with NULL system."); \
901 return 0; \
902 } \
903 return sys->TYPE.mnum; \
904 }
905
906 #define DEFINE_SLV_METHODS(D) \
907 D(vars) \
908 D(pars) \
909 D(unattached) \
910 D(dvars) \
911 D(disunatt) \
912 D(rels) \
913 D(condrels) \
914 D(objs) \
915 D(logrels) \
916 D(condlogrels) \
917 D(whens) \
918 D(bnds)
919
920 DEFINE_SLV_METHODS(DEFINE_SOLVERS_GET_NUM_METHOD)
921 DEFINE_SLV_METHODS(DEFINE_MASTER_GET_NUM_METHOD)
922
923 void slv_set_obj_relation(slv_system_t sys,struct rel_relation *obj)
924 {
925 if (sys==NULL) {
926 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_obj_relation called with NULL system.\n");
927 return;
928 }
929 sys->obj = obj;
930 }
931
932 struct rel_relation *slv_get_obj_relation(slv_system_t sys)
933 {
934 if (sys==NULL) {
935 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_obj_relation called with NULL system.\n");
936 return NULL;
937 }
938 return sys->obj;
939 }
940
941 void slv_set_obj_variable(slv_system_t sys,struct var_variable *objvar,
942 unsigned maximize)
943 {
944 if (sys==NULL) {
945 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_obj_variable called with NULL system.\n");
946 return;
947 }
948 sys->objvar = objvar;
949 if (objvar!=NULL) {
950 if (maximize) {
951 sys->objvargrad = -1;
952 } else {
953 sys->objvargrad = 1;
954 }
955 } else {
956 sys->objvargrad = 0;
957 }
958 }
959
960 struct var_variable *slv_get_obj_variable(slv_system_t sys)
961 {
962 if (sys==NULL) {
963 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_obj_variable called with NULL system.\n");
964 return NULL;
965 }
966 return sys->objvar;
967 }
968
969 real64 slv_get_obj_variable_gradient(slv_system_t sys)
970 {
971 if (sys==NULL) {
972 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_obj_variable_gradient called with NULL system.\n");
973 return 0.0;
974 }
975 return sys->objvargrad;
976 }
977
978
979 void slv_set_need_consistency(slv_system_t sys, int32 need_consistency)
980 {
981 if (sys==NULL) {
982 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_need_consistency called with NULL system.\n");
983 return;
984 }
985
986 sys->need_consistency = need_consistency;
987 }
988
989
990 int32 slv_need_consistency(slv_system_t sys)
991 {
992 if (sys==NULL) {
993 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_need_consistency called with NULL system.\n");
994 return 0;
995 }
996 return sys->need_consistency;
997 }
998
999 /*----------------------------------------------------------------
1000 Macros to define
1001
1002 slv_count_vars
1003 rels
1004 dvars
1005 logrels
1006 whens
1007 bnds
1008 */
1009
1010 #define DEFINE_SLV_COUNT_METHOD(NAME,FILTER,TYPE) \
1011 static int slv_count_##NAME(FILTER##_filter_t *filter, struct TYPE **list){ \
1012 int ret=0; \
1013 assert(list!=NULL); \
1014 while(*list!=NULL){ \
1015 ret += FILTER##_apply_filter(*list,filter); \
1016 list++; \
1017 } \
1018 return ret; \
1019 }
1020
1021 #define DEFINE_SLV_COUNT_METHODS(D) \
1022 D(vars,var,var_variable) \
1023 D(rels,rel,rel_relation) \
1024 D(dvars,dis,dis_discrete) \
1025 D(logrels,logrel,logrel_relation) \
1026 D(whens,when,w_when) \
1027 D(bnds,bnd,bnd_boundary)
1028
1029 DEFINE_SLV_COUNT_METHODS(DEFINE_SLV_COUNT_METHOD)
1030
1031 /*--------------------------------------------------------------
1032 Methods to define
1033 slv_count_solvers_*
1034 slv_count_master_*
1035 */
1036
1037 /** This macro automates the declaration of the slv_count_solvers_* methods */
1038 #define DEFINE_SLV_COUNT_SOLVER_METHOD(NAME,PROP,TYPE,COUNT) \
1039 int slv_count_solvers_ ## NAME ( slv_system_t sys, TYPE ##_filter_t *xxx){ \
1040 if(sys==NULL || sys->PROP.solver == NULL || xxx==NULL){ \
1041 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_cound_solvers_" #NAME " called with NULL"); \
1042 return 0; \
1043 } \
1044 return slv_count_##COUNT(xxx,sys->PROP.solver); \
1045 }
1046
1047 /** This macro automates the declaration of the slv_count_master_* methods */
1048 #define DEFINE_SLV_COUNT_MASTER_METHOD(NAME,PROP,TYPE,COUNT) \
1049 int slv_count_master_ ## NAME ( slv_system_t sys, TYPE ##_filter_t *xxx){ \
1050 if(sys==NULL || sys->PROP.master == NULL || xxx==NULL){ \
1051 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_cound_master_" #NAME " called with NULL"); \
1052 return 0; \
1053 } \
1054 return slv_count_##COUNT(xxx,sys->PROP.master); \
1055 }
1056
1057 /** The macro makes all the various * declarations of the methods of type D (master or solvers) */
1058 #define DEFINE_COUNT_METHODS(D) \
1059 D(vars,vars,var,vars) \
1060 D(pars,pars,var,vars) \
1061 D(unattached,unattached,var,vars) \
1062 D(dvars,dvars,dis,dvars) \
1063 D(disunatt,disunatt,dis,dvars) \
1064 D(rels,rels,rel,rels) \
1065 D(condrels,condrels,rel,rels) \
1066 D(objs,objs,rel,rels) \
1067 D(logrels,logrels,logrel,logrels) \
1068 D(condlogrels,condlogrels,logrel,logrels) \
1069 D(whens,whens,when,whens) \
1070 D(bnds,bnds,bnd,bnds)
1071
1072 /** Invoke the DEFINE_COUNT_METHODS macro for SOLVERS methods */
1073 DEFINE_COUNT_METHODS(DEFINE_SLV_COUNT_SOLVER_METHOD)
1074 /** Invoke the DEFINE_COUNT_METHODS macro for MASTER methods */
1075 DEFINE_COUNT_METHODS(DEFINE_SLV_COUNT_MASTER_METHOD)
1076
1077 /*------------------------------------------------------*/
1078
1079 static void printwarning(const char * fname, slv_system_t sys)
1080 {
1081 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,
1082 "%s called with bad registered client (%s).",fname,
1083 slv_solver_name(sys->solver));
1084 }
1085
1086 static void printinfo(slv_system_t sys, const char *rname)
1087 {
1088 if (CF(sys,name) == NULL ) {
1089 ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,
1090 "Client %s does not support function %s\n",
1091 slv_solver_name(sys->solver),rname);
1092 }
1093 }
1094
1095 int slv_eligible_solver(slv_system_t sys)
1096 {
1097 if ( CF(sys,celigible) == NULL ) {
1098 printwarning("slv_eligible_solver",sys);
1099 return 0;
1100 }
1101 return SF(sys,celigible)(sys);
1102 }
1103
1104 int slv_select_solver(slv_system_t sys,int solver){
1105
1106 int status_index;
1107 SlvClientDestroyF *destroy;
1108
1109 if (sys ==NULL) {
1110 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver called with NULL system\n");
1111 return -1;
1112 }
1113 if ( solver >= 0 && solver < NORC ) {
1114 if (sys->ct != NULL && solver != sys->solver) {
1115 destroy = SlvClientsData[sys->solver].cdestroy;
1116 if(destroy!=NULL) {
1117 (destroy)(sys,sys->ct);
1118 sys->ct = NULL;
1119 } else {
1120 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver: 'cdestroy' is undefined on solver '%s' (index %d).",
1121 slv_solver_name(sys->solver), sys->solver);
1122 }
1123 }
1124
1125 if (sys->ct != NULL) {
1126 return sys->solver;
1127 }
1128
1129 status_index = solver;
1130 sys->solver = solver;
1131 if ( CF(sys,ccreate) != NULL) {
1132 sys->ct = SF(sys,ccreate)(sys,&status_index);
1133 } else {
1134 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_select_solver create failed due to bad client %s\n",
1135 slv_solver_name(sys->solver));
1136 return sys->solver;
1137 }
1138 if (sys->ct==NULL) {
1139 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate failed in slv_select_solver\n");
1140 sys->solver = -1;
1141 } else {
1142 if (status_index) {
1143 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate succeeded with warning %d %s\n",
1144 status_index," in slv_select_solver");
1145 }
1146 /* we could do a better job explaining the client warnings... */
1147 sys->solver = solver;
1148 }
1149 } else {
1150 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver: invalid solver index '%d'.",
1151 solver);
1152 return -1;
1153 }
1154 return sys->solver;
1155 }
1156
1157
1158 int slv_switch_solver(slv_system_t sys,int solver)
1159 {
1160 int status_index;
1161
1162 if (sys ==NULL) {
1163 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_switch_solver called with NULL system\n");
1164 return -1;
1165 }
1166 if( solver >= 0 && solver < g_SlvNumberOfRegisteredClients ){
1167 status_index = solver;
1168 sys->solver = solver;
1169 if ( CF(sys,ccreate) != NULL) {
1170 sys->ct = SF(sys,ccreate)(sys,&status_index);
1171 } else {
1172 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_switch_solver create failed due to bad client %s\n",
1173 slv_solver_name(sys->solver));
1174 return sys->solver;
1175 }
1176 if (sys->ct==NULL) {
1177 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"SlvClientCreate failed in slv_switch_solver\n");
1178 sys->solver = -1;
1179 } else {
1180 if (status_index) {
1181 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate succeeded with warning %d %s\n",
1182 status_index," in slv_switch_solver");
1183 }
1184 sys->solver = solver;
1185 }
1186 } else {
1187 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_switch_solver called with unknown client (%d)\n",solver);
1188 return -1;
1189 }
1190 return sys->solver;
1191 }
1192
1193 void slv_set_char_parameter(char **cp, char *newvalue)
1194 {
1195 if (cp != NULL) {
1196 if (*cp != NULL) {
1197 ascfree(*cp);
1198 }
1199 *cp = ascstrdup(newvalue);
1200 }
1201 }
1202
1203 void slv_destroy_parms(slv_parameters_t *p) {
1204 int32 i,j;
1205 for (i = 0; i < p->num_parms; i++) {
1206 switch(p->parms[i].type) {
1207 case char_parm:
1208 ascfree(p->parms[i].info.c.value);
1209 for (j = 0; j < p->parms[i].info.c.high; j++) {
1210 ascfree(p->parms[i].info.c.argv[j]);
1211 }
1212 ascfree(p->parms[i].info.c.argv);
1213 /* FALL THROUGH */
1214 case int_parm:
1215 case bool_parm:
1216 case real_parm:
1217 ascfree(p->parms[i].name);
1218 ascfree(p->parms[i].interface_label);
1219 ascfree(p->parms[i].description);
1220 break;
1221 default:
1222 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Unrecognized parameter type in slv_destroy_parms\n");
1223 }
1224 }
1225 if (p->parms && p->dynamic_parms) {
1226 ascfree(p->parms);
1227 }
1228 }
1229
1230 int32 slv_define_parm(slv_parameters_t *p,
1231 enum parm_type type,
1232 char *name,
1233 char *interface_label,
1234 char *description,
1235 union parm_arg value,
1236 union parm_arg low,
1237 union parm_arg high,
1238 int32 display)
1239 {
1240 int32 len,length,i, err=1;
1241 if (p == NULL) {
1242 return -1;
1243 }
1244 length = p->num_parms;
1245
1246 switch (type) {
1247 case int_parm:
1248 err = 0;
1249 p->parms[length].info.i.value = value.argi;
1250 p->parms[length].info.i.low = low.argi;
1251 p->parms[length].info.i.high = high.argi;
1252 break;
1253
1254 case bool_parm:
1255 err = 0;
1256 p->parms[length].info.b.value = value.argb;
1257 p->parms[length].info.b.low = low.argb;
1258 p->parms[length].info.b.high = high.argb;
1259 break;
1260
1261 case real_parm:
1262 err = 0;
1263 p->parms[length].info.r.value = value.argr;
1264 p->parms[length].info.r.low = low.argr;
1265 p->parms[length].info.r.high = high.argr;
1266 break;
1267
1268 case char_parm:
1269 err = 0;
1270 p->parms[length].info.c.argv =
1271 (char **)ascmalloc(high.argi*sizeof(char *));
1272 for (i = 0; i < high.argi; i++) {
1273 len = strlen(low.argv[i]);
1274 p->parms[length].info.c.argv[i] =(char *)ascmalloc(len+1*sizeof(char));
1275 strcpy(p->parms[length].info.c.argv[i],low.argv[i]);
1276 }
1277
1278 p->parms[length].info.c.value =
1279 (char *)ascmalloc(strlen(value.argc)+1*sizeof(char));
1280 strcpy(p->parms[length].info.c.value,value.argc);
1281
1282 p->parms[length].info.c.high = high.argi;
1283 break;
1284
1285 default:
1286 return -1;
1287 }
1288 if (!err) {
1289 p->parms[length].type = type;
1290 p->parms[length].number = length;
1291
1292 len = strlen(name);
1293 p->parms[length].name = (char *)ascmalloc(len+1*sizeof(char));
1294 strcpy(p->parms[length].name,name);
1295
1296 len = strlen(interface_label);
1297 p->parms[length].interface_label = (char *)ascmalloc(len+1*sizeof(char));
1298 strcpy(p->parms[length].interface_label,interface_label);
1299
1300 len = strlen(description);
1301 p->parms[length].description = (char *)ascmalloc(len+1*sizeof(char));
1302 strcpy(p->parms[length].description,description);
1303
1304 p->parms[length].display = display;
1305 } else {
1306 p->parms[length].type = -1;
1307 }
1308 p->num_parms++;
1309 return p->num_parms;
1310 }
1311
1312 int slv_get_selected_solver(slv_system_t sys)
1313 {
1314 if (sys!=NULL) return sys->solver;
1315 return -1;
1316 }
1317
1318 int32 slv_get_default_parameters(int index,
1319 slv_parameters_t *parameters)
1320 {
1321 if (index >= 0 && index < NORC) {
1322 if ( SlvClientsData[index].getdefparam == NULL ) {
1323 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_default_parameters called with parameterless index\n");
1324 return 0;
1325 } else {
1326 /* send NULL system when setting up interface */
1327 (SlvClientsData[index].getdefparam)(NULL,NULL,parameters);
1328 return 1;
1329 }
1330 } else {
1331 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_default_parameters called with unregistered index\n");
1332 return 0;
1333 }
1334 }
1335
1336 /*-----------------------------------------------------------
1337 These macros do some more elimination of repetition. Here we're
1338 trying to replace some more complex 'method-like' calls on
1339 slv_system_t:
1340
1341 These macros use macro-argument-concatenation and macro stringification.
1342 Verified that the former works with Visual C++:
1343 getlinso://www.codeproject.com/macro/metamacros.asp
1344 */
1345
1346 /** Define a method like 'void slv_METHODNAME(sys)' */
1347 #define DEFINE_SLV_PROXY_METHOD_VOID(METHOD) \
1348 void slv_ ## METHOD (slv_system_t sys){ \
1349 if(CF(sys,METHOD)==NULL){ \
1350 printwarning(#METHOD,sys); \
1351 return; \
1352 } \
1353 SF(sys,METHOD)(sys,sys->ct); \
1354 }
1355
1356 /** Define a method like 'RETURNTYPE slv_METHOD(sys)'; */
1357 #define DEFINE_SLV_PROXY_METHOD(METHOD,PROP,RETTYPE) \
1358 RETTYPE slv_ ## METHOD (slv_system_t sys){ \
1359 if(CF(sys,PROP)==NULL){ \
1360 printwarning(#METHOD,sys); \
1361 return; \
1362 } \
1363 return SF(sys,PROP)(sys,sys->ct); \
1364 }
1365
1366 /** Define a method like 'void slv_METHOD(sys,TYPE PARAMNAME)'; */
1367 #define DEFINE_SLV_PROXY_METHOD_PARAM(METHOD,PROP,PARAMTYPE,PARAMNAME) \
1368 void slv_ ## METHOD (slv_system_t sys, PARAMTYPE PARAMNAME){ \
1369 if(CF(sys,PROP)==NULL){ \
1370 printwarning(#METHOD,sys); \
1371 return; \
1372 } \
1373 SF(sys,PROP)(sys,sys->ct, PARAMNAME); \
1374 }
1375
1376 DEFINE_SLV_PROXY_METHOD_PARAM(get_parameters,getparam,slv_parameters_t*,parameters);
1377
1378 void slv_set_parameters(slv_system_t sys,slv_parameters_t *parameters)
1379 {
1380 if ( CF(sys,setparam) == NULL ) {
1381 printwarning("slv_set_parameters",sys);
1382 return;
1383 }
1384 if (parameters->whose != sys->solver) {
1385 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,
1386 "slv_set_parameters can give parameters from one client to a different client.");
1387 return;
1388 }
1389 SF(sys,setparam)(sys,sys->ct,parameters);
1390 }
1391
1392 DEFINE_SLV_PROXY_METHOD_PARAM(get_status,getstatus,slv_status_t*,status);
1393 DEFINE_SLV_PROXY_METHOD(get_linsolv_sys, getlinsol, linsol_system_t);
1394 DEFINE_SLV_PROXY_METHOD(get_sys_mtx, getsysmtx, mtx_matrix_t);
1395 DEFINE_SLV_PROXY_METHOD(get_linsolqr_sys, getlinsys, linsolqr_system_t);
1396 DEFINE_SLV_PROXY_METHOD_PARAM(dump_internals,dumpinternals,int,level);
1397 DEFINE_SLV_PROXY_METHOD_VOID(presolve);
1398 DEFINE_SLV_PROXY_METHOD_VOID(resolve);
1399 DEFINE_SLV_PROXY_METHOD_VOID(iterate);
1400 DEFINE_SLV_PROXY_METHOD_VOID(solve);
1401
1402 /*-----------------------------------------------------------*/
1403
1404 SlvClientToken slv_get_client_token(slv_system_t sys)
1405 {
1406 if (sys==NULL) {
1407 FPRINTF(stderr,"slv_get_client_token called with NULL system.\n");
1408 return NULL;
1409 }
1410 return sys->ct;
1411 }
1412
1413
1414 void slv_set_client_token(slv_system_t sys, SlvClientToken ct)
1415 {
1416 if (sys==NULL) {
1417 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_client_token called with NULL system.\n");
1418 return;
1419 }
1420 sys->ct = ct;
1421 }
1422
1423 void slv_set_solver_index(slv_system_t sys, int solver)
1424 {
1425 if (sys==NULL) {
1426 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solver_index called with NULL system.\n");
1427 return;
1428 }
1429 sys->solver = solver;
1430 }
1431
1432 /*********************************************************************\
1433 unregistered client functions that need to go elsewhere(other files).
1434 hereunder are utility calls which are unstandardized
1435 \*********************************************************************/
1436
1437 boolean slv_change_basis(slv_system_t sys, int32 var, mtx_range_t *rng)
1438 {
1439 (void)sys;
1440 (void)var;
1441 (void)rng;
1442 Asc_Panic(2, "slv_change_basis", "fix me");
1443 return 0;
1444 }
1445
1446 /*
1447 * This routine is provided as the start of some report generation
1448 * capabilities. It operates off the main solve system and
1449 * writes out the relation residuals and variable values for
1450 * the entire problem to the named file.
1451 * Isn't very bright.
1452 */
1453
1454 void slv_print_output(FILE *out, slv_system_t sys)
1455 {
1456 struct rel_relation **rp;
1457 struct var_variable **vp;
1458 int nrels, nvars,c;
1459
1460 vp = slv_get_master_var_list(sys);
1461 nvars = slv_get_num_master_vars(sys);
1462 FPRINTF(out,"%-6s %-12s\n",
1463 "INDEX","LEVEL");
1464 for (c=0; c<nvars; c++) {
1465 FPRINTF(out," % -6d % -12.8e\n",c, var_value(vp[c]));
1466 }
1467 PUTC('\n',out);
1468
1469 rp = slv_get_master_rel_list(sys);
1470 nrels = slv_get_num_master_rels(sys);
1471 FPRINTF(out,"%-6s %-12s\n",
1472 "INDEX","RESDUAL");
1473 for (c=0; c<nrels; c++) {
1474 FPRINTF(out," % -6d % -12.8e\n",c, rel_residual(rp[c]));
1475 }
1476 }
1477
1478 int32 slv_obj_select_list(slv_system_t sys,int32 **rip)
1479 {
1480 int32 len,count,i, *ra;
1481 static rel_filter_t rfilter;
1482 struct rel_relation **rlist=NULL;
1483 len = slv_get_num_solvers_objs(sys);
1484 ra = *rip = (int32 *)ascmalloc((len+1)*sizeof(int32 *));
1485 rfilter.matchbits = (REL_INCLUDED);
1486 rfilter.matchvalue =(REL_INCLUDED);
1487 rlist = slv_get_solvers_obj_list(sys);
1488 count = 0;
1489 for (i = 0; i < len; i++) {
1490 if (rel_apply_filter(rlist[i],&rfilter)) {
1491 ra[count] = i;
1492 count++;
1493 }
1494 }
1495 ra[count] = -1;
1496 return count;
1497 }
1498
1499 int32 slv_get_obj_num(slv_system_t sys)
1500 {
1501 int32 len,i;
1502 struct rel_relation *obj;
1503 struct rel_relation **rlist=NULL;
1504 len = slv_get_num_solvers_objs(sys);
1505 rlist = slv_get_solvers_obj_list(sys);
1506 obj = slv_get_obj_relation(sys);
1507 if (obj != NULL) {
1508 for (i = 0; i < len; i++) {
1509 if (rlist[i] == obj) {
1510 return i;
1511 }
1512 }
1513 }
1514 return -1;
1515 }
1516
1517 int32 slv_near_bounds(slv_system_t sys,real64 epsilon,
1518 int32 **vip)
1519 {
1520 int32 len,i, *va, index;
1521 real64 comp;
1522 static var_filter_t vfilter;
1523 struct var_variable **vlist=NULL;
1524 len = slv_get_num_solvers_vars(sys);
1525 va = *vip = (int32 *)ascmalloc((2*len+2)*sizeof(int32 *));
1526 vfilter.matchbits = (VAR_FIXED | VAR_INCIDENT | VAR_SVAR | VAR_ACTIVE);
1527 vfilter.matchvalue = (VAR_INCIDENT | VAR_SVAR | VAR_ACTIVE);
1528 vlist = slv_get_solvers_var_list(sys);
1529 va[0] = va[1] = 0;
1530 index = 2;
1531 for (i = 0; i < len; i++) {
1532 if (var_apply_filter(vlist[i],&vfilter)) {
1533 comp = (var_value(vlist[i]) - var_lower_bound(vlist[i]))
1534 / var_nominal(vlist[i]);
1535 if (comp < epsilon) {
1536 va[index] = i;
1537 index++;
1538 va[0]++;
1539 }
1540 }
1541 }
1542 for (i = 0; i < len; i++) {
1543 if (var_apply_filter(vlist[i],&vfilter)) {
1544 comp = (var_upper_bound(vlist[i]) - var_value(vlist[i]))
1545 / var_nominal(vlist[i]);
1546 if (comp < epsilon) {
1547 va[index] = i;
1548 index++;
1549 va[1]++;
1550 }
1551 }
1552 }
1553 return index - 2;
1554 }
1555
1556 int32 slv_far_from_nominals(slv_system_t sys,real64 bignum,
1557 int32 **vip)
1558 {
1559 int32 len,i, *va, index;
1560 real64 comp;
1561 static var_filter_t vfilter;
1562 struct var_variable **vlist=NULL;
1563 len = slv_get_num_solvers_vars(sys);
1564 va = *vip = (int32 *)ascmalloc((len+1)*sizeof(int32 *));
1565 vfilter.matchbits = (VAR_FIXED | VAR_INCIDENT | VAR_SVAR | VAR_ACTIVE);
1566 vfilter.matchvalue = (VAR_INCIDENT | VAR_SVAR | VAR_ACTIVE);
1567 vlist = slv_get_solvers_var_list(sys);
1568 index = 0;
1569 for (i = 0; i < len; i++) {
1570 if (var_apply_filter(vlist[i],&vfilter)) {
1571 comp = fabs(var_value(vlist[i]) - var_nominal(vlist[i]))
1572 / var_nominal(vlist[i]);
1573 if (comp > bignum) {
1574 va[index] = i;
1575 index++;
1576 }
1577 }
1578 }
1579 return index;
1580 }
1581

Properties

Name Value
svn:executable *

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