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

Properties

Name Value
svn:executable *

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