/[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 201 - (show annotations) (download) (as text)
Sat Jan 21 03:48:27 2006 UTC (14 years, 1 month ago) by johnpye
File MIME type: text/x-csrc
File size: 43437 byte(s)
Cleaning up a little
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 int slv_destroy(slv_system_t sys)
399 {
400 int ret = 0;
401 if (sys->ct != NULL) {
402 if ( CF(sys,cdestroy) == NULL ) {
403 ERROR_REPORTER_HERE(ASC_PROG_FATAL,"slv_destroy: SlvClientToken 0x%p not freed by %s",
404 sys->ct,SF(sys,name));
405 } else {
406 if ( SF(sys,cdestroy)(sys,sys->ct) ) {
407 ret++;
408 }
409 }
410 }
411 if (ret) {
412 ERROR_REPORTER_HERE(ASC_PROG_FATAL,"slv_destroy: slv_system_t 0x%p not freed.",sys);
413 } else {
414
415 SLV_FREE_BUFS(SLV_FREE_BUF, SLV_FREE_BUF_GLOBAL)
416
417 if (sys->data.incidence != NULL) ascfree(sys->data.incidence);
418 sys->data.incidence = NULL;
419 if (sys->data.varincidence != NULL) ascfree(sys->data.varincidence);
420 sys->data.varincidence = NULL;
421 if (sys->data.logincidence != NULL) ascfree(sys->data.logincidence);
422 sys->data.incidence = NULL;
423 ascfree( (POINTER)sys );
424 }
425 return ret;
426 }
427
428 void slv_destroy_client(slv_system_t sys)
429 {
430
431 if (sys->ct != NULL) {
432 if ( CF(sys,cdestroy) == NULL ) {
433 ERROR_REPORTER_HERE(ASC_PROG_ERR,
434 "SlvClientToken 0x%p not freed in slv_destroy_client",sys->ct);
435 } else {
436 if ( SF(sys,cdestroy)(sys,sys->ct) ) {
437 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_destroy_client: SlvClientToken not freed");
438 } else {
439 sys->ct = NULL;
440 }
441 }
442 }
443 }
444
445 /*---------------------------------------------------------
446 get/set instance
447 */
448
449 SlvBackendToken slv_instance(slv_system_t sys)
450 {
451 if (sys == NULL) {
452 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_instance: called with NULL system.");
453 return NULL;
454 } else {
455 return sys->instance;
456 }
457 }
458
459 void slv_set_instance(slv_system_t sys,SlvBackendToken instance)
460 {
461 if (sys == NULL) {
462 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_set_instance: called with NULL system.");
463 return;
464 } else {
465 sys->instance = instance;
466 }
467 }
468
469 dof_t *slv_get_dofdata(slv_system_t sys)
470 {
471 return &(sys->dof);
472 }
473
474 dof_t *slv_get_log_dofdata(slv_system_t sys)
475 {
476 return &(sys->logdof);
477 }
478
479 int32 slv_get_num_models(slv_system_t sys)
480 {
481 if (sys == NULL) {
482 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_get_num_models: called with NULL system.");
483 return 0;
484 } else {
485 return sys->nmodels;
486 }
487 }
488 void slv_set_num_models(slv_system_t sys, int32 nmod)
489 {
490 if (sys == NULL) {
491 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_set_num_models: called with NULL system.");
492 } else {
493 sys->nmodels = nmod;
494 }
495 }
496
497
498 void slv_set_symbol_list(slv_system_t sys,
499 struct gl_list_t *sv)
500 {
501 if (sys->symbollist != NULL) {
502 DestroySymbolValuesList(sys->symbollist);
503 }
504 sys->symbollist = sv;
505 }
506
507 /*--------------------------------------------------------]
508 Macros to declare
509
510 slv_set_master_*_list(slv_system_t sys, string var_variable **list, int size)
511 slv_set_*_buf(slv_system_t sys, string var_variable **list, int size)
512 */
513
514 #define DEFINE_SET_MASTER_LIST_METHOD(NAME,PROP,TYPE) \
515 void slv_set_master_##NAME##_list(slv_system_t sys, struct TYPE **vlist, int size){ \
516 SFUN(sys->PROP.master); \
517 sys->PROP.mnum = size; \
518 sys->PROP.master = vlist; \
519 }
520
521
522
523 #define DEFINE_SET_MASTER_LIST_METHODS(D) \
524 D(var,vars,var_variable) \
525 D(par,pars,var_variable) \
526 D(unattached,unattached,var_variable); \
527 D(dvar,dvars,dis_discrete) \
528 D(disunatt,disunatt,dis_discrete) \
529 D(rel,rels,rel_relation) \
530 D(condrel,condrels,rel_relation) \
531 D(obj,objs,rel_relation) \
532 D(logrel,logrels,logrel_relation) \
533 D(condlogrel,condlogrels,logrel_relation) \
534 D(when,whens,w_when) \
535 D(bnd,bnds,bnd_boundary)
536
537 DEFINE_SET_MASTER_LIST_METHODS(DEFINE_SET_MASTER_LIST_METHOD)
538
539 /*------------------------------------------------------------
540 Macros to declare
541
542 slv_set_NAME_buf(slv_system_t sts, struct TYPE *PROP)
543 */
544
545 #define DEFINE_SET_BUF_METHOD(NAME,PROP,TYPE) \
546 void slv_set_##NAME##_buf(slv_system_t sys, struct TYPE *PROP){ \
547 if(sys->PROP.buf !=NULL ){ \
548 Asc_Panic(2,"slv_set_" #NAME "_buf","bad call."); \
549 }else{ \
550 sys->PROP.buf = PROP; \
551 } \
552 }
553
554 #define DEFINE_SET_BUF_METHOD_GLOBAL(NAME,PROP,TYPE) \
555 void slv_set_##NAME##_buf(slv_system_t sys, struct TYPE *buf, int len){ \
556 if(sys->PROP.buf != NULL){ \
557 Asc_Panic(2,"slv_set_" #NAME "_buf","bad call."); \
558 }else{ \
559 sys->PROP.buf = buf; \
560 g_number_of_##PROP = len; \
561 } \
562 }
563
564 #define DEFINE_SET_BUF_METHODS(D, D_GLOBAL) \
565 D(var,vars,var_variable) \
566 D(par,pars,var_variable) \
567 D(unattached,unattached,var_variable) \
568 D(disunatt,disunatt,dis_discrete) \
569 D(rel,rels,rel_relation) \
570 D(condrel,condrels,rel_relation) \
571 D(obj,objs,rel_relation) \
572 D(logrel,logrels,logrel_relation) \
573 D(condlogrel,condlogrels,logrel_relation) \
574 D_GLOBAL(dvar, dvars, dis_discrete) \
575 D_GLOBAL(when, whens, w_when) \
576 D_GLOBAL(bnd,bnds,bnd_boundary)
577
578
579 DEFINE_SET_BUF_METHODS(DEFINE_SET_BUF_METHOD, DEFINE_SET_BUF_METHOD_GLOBAL)
580
581 /*---------------------------------------------------------------
582 Macros to define
583 slv_set_incidence
584 slv_set_var_incidence
585 slv_set_logincidence
586 */
587
588 #define DEFINE_SET_INCIDENCE(NAME,PROP,TYPE,SIZE) \
589 void slv_set_##NAME(slv_system_t sys, struct TYPE **inc, long s){ \
590 if(sys->data.PROP != NULL || inc == NULL){ \
591 Asc_Panic(2,"slv_set_" #NAME,"bad call"); \
592 }else{ \
593 sys->data.PROP = inc; \
594 sys->data.SIZE = s; \
595 } \
596 }
597
598 #define DEFINE_SET_INCIDENCES(D) \
599 D(incidence, incidence, var_variable, incsize) \
600 D(var_incidence, varincidence, rel_relation, varincsize) \
601 D(logincidence, logincidence, dis_discrete, incsize)
602
603 DEFINE_SET_INCIDENCES(DEFINE_SET_INCIDENCE)
604
605 /*-------------------------------------------------------------*/
606
607 void slv_set_extrel_list(slv_system_t sys,struct ExtRelCache **erlist,
608 int size)
609 {
610 if (sys->extrels.erlist !=NULL ) {
611 Asc_Panic(2,"slv_set_extrel_list",
612 "bad call.");
613 }
614 sys->extrels.num_extrels = size;
615 sys->extrels.erlist = erlist;
616 }
617
618 struct ExtRelCache **slv_get_extrel_list(slv_system_t sys)
619 {
620 return sys->extrels.erlist;
621 }
622
623 int slv_get_num_extrels(slv_system_t sys)
624 {
625 return sys->extrels.num_extrels;
626 }
627
628
629 /*********************************************************************\
630 client functions.
631 \*********************************************************************/
632 int Solv_C_CheckHalt()
633 {
634 if (Solv_C_CheckHalt_Flag)
635 return 1;
636 else
637 return 0;
638 }
639
640 const char *slv_solver_name(int index)
641 {
642 static char errname[] = "ErrorSolver";
643 if (index >= 0 && index < NORC) {
644 if ( SlvClientsData[index].name == NULL ) {
645 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_solver_name: unnamed solver: index='%d'",index);
646 return errname;
647 } else {
648 return SlvClientsData[index].name;
649 }
650 } else {
651 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_solver_name: invalid solver index '%d'", index);
652 return errname;
653 }
654 }
655
656 const mtx_block_t *slv_get_solvers_blocks(slv_system_t sys)
657 {
658 if (sys == NULL) {
659 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_solvers_blocks called with NULL system");
660 return NULL;
661 } else {
662 return &(sys->dof.blocks);
663 }
664 }
665
666 const mtx_block_t *slv_get_solvers_log_blocks(slv_system_t sys)
667 {
668 if (sys == NULL) {
669 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_solvers_log_blocks called with NULL system");
670 return NULL;
671 } else {
672 return &(sys->logdof.blocks);
673 }
674 }
675
676 void slv_set_solvers_blocks(slv_system_t sys,int len, mtx_region_t *data)
677 {
678 if (sys == NULL || len < 0) {
679 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solvers_blocks called with NULL system or bad len.\n");
680 } else {
681 if (len && data==NULL) {
682 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solvers_blocks called with bad data.\n");
683 } else {
684 if (sys->dof.blocks.nblocks && sys->dof.blocks.block != NULL) {
685 ascfree(sys->dof.blocks.block);
686 }
687 sys->dof.blocks.block = data;
688 sys->dof.blocks.nblocks = len;
689 }
690 }
691 }
692
693 void slv_set_solvers_log_blocks(slv_system_t sys,int len, mtx_region_t *data)
694 {
695 if (sys == NULL || len < 0) {
696 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solvers_log_blocks called with NULL system or bad len\n");
697 } else {
698 if (len && data==NULL) {
699 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solvers_log_blocks called with bad data.\n");
700 } else {
701 if (sys->logdof.blocks.nblocks && sys->logdof.blocks.block != NULL) {
702 ascfree(sys->logdof.blocks.block);
703 }
704 sys->logdof.blocks.block = data;
705 sys->logdof.blocks.nblocks = len;
706 }
707 }
708 }
709
710 void slv_check_var_initialization(slv_system_t sys){
711 struct var_variable **vp;
712 for (vp = slv_get_solvers_var_list(sys); *vp != NULL; vp++) {
713 if (!AtomAssigned((struct Instance *)var_instance(*vp))) {
714 var_set_value(*vp,var_nominal(*vp));
715 }
716 }
717 }
718
719 void slv_check_dvar_initialization(slv_system_t sys)
720 {
721 struct dis_discrete **vp;
722
723 for (vp = slv_get_solvers_dvar_list(sys); *vp != NULL; vp++) {
724 if (!AtomAssigned((struct Instance *)dis_instance(*vp))) {
725 dis_set_boolean_value(*vp,1);
726 }
727 }
728 }
729
730
731 void slv_bnd_initialization(slv_system_t sys)
732 {
733 struct bnd_boundary **bp;
734 int32 value;
735
736 for (bp = slv_get_solvers_bnd_list(sys); *bp != NULL; bp++) {
737 value = bndman_calc_satisfied(*bp);
738 bnd_set_cur_status(*bp,value);
739 bnd_set_pre_status(*bp,value);
740 bnd_set_crossed(*bp,FALSE);
741 if (bnd_kind(*bp) == e_bnd_rel) {
742 value = bndman_calc_at_zero(*bp);
743 bnd_set_at_zero(*bp,value);
744 } else {
745 bnd_set_at_zero(*bp,FALSE);
746 }
747 }
748 }
749
750 struct gl_list_t *slv_get_symbol_list(slv_system_t sys)
751 {
752 if (sys==NULL) {
753 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_symbol_list called with NULL system.\n");
754 return NULL;
755 }
756 return sys->symbollist;
757 }
758
759 /*---------------------------------------------------------
760 Macros to define
761
762 slv_set_solvers_*_list
763 slv_get_solvers_*_list
764 slv_get_master_*_list
765 */
766 #define DEFINE_SET_SOLVERS_LIST_METHOD(NAME,PROP,TYPE) \
767 void slv_set_solvers_##NAME##_list(slv_system_t sys, struct TYPE **vlist, int size){ \
768 if(sys->PROP.master==NULL){ \
769 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"slv_set_solvers_" #NAME "_list: called before slv_set_master_" #NAME "_list."); \
770 /* might be ok, no return */ \
771 } \
772 sys->PROP.snum = size; \
773 sys->PROP.solver = vlist; \
774 }
775
776 #define DEFINE_SET_SOLVERS_LIST_METHOD_RETURN(NAME,PROP,TYPE) \
777 void slv_set_solvers_##NAME##_list(slv_system_t sys, struct TYPE **vlist, int size){ \
778 if(sys->PROP.master==NULL){ \
779 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"slv_set_solvers_" #NAME "_list: called before slv_set_master_" #NAME "_list."); \
780 return; /* can't be OK, so return now */ \
781 } \
782 sys->PROP.snum = size; \
783 sys->PROP.solver = vlist; \
784 }
785
786 #define DEFINE_GET_SOLVERS_LIST_METHOD(NAME,PROP,TYPE) \
787 struct TYPE **slv_get_solvers_##NAME##_list(slv_system_t sys){ \
788 if (sys->PROP.solver == NULL) { \
789 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_solvers_" #NAME "_list: returning NULL (?)."); \
790 } \
791 return sys->PROP.solver; \
792 }
793
794 #define DEFINE_GETSET_LIST_METHODS(D,D_RETURN) \
795 D_RETURN(var,vars,var_variable) \
796 D(par,pars,var_variable) \
797 D(unattached,unattached,var_variable) \
798 D_RETURN(dvar,dvars,dis_discrete) \
799 D(disunatt,disunatt,dis_discrete) \
800 D_RETURN(rel,rels,rel_relation) \
801 D_RETURN(obj,objs,rel_relation) \
802 D_RETURN(condrel,condrels,rel_relation) \
803 D_RETURN(logrel,logrels,logrel_relation) \
804 D_RETURN(condlogrel,condlogrels,logrel_relation) \
805 D_RETURN(when,whens,w_when) \
806 D_RETURN(bnd,bnds,bnd_boundary)
807
808 /* the slv_set_solvers_*_list methods: some have a 'return' when sys->PROP.master==NULL; others do not: */
809 DEFINE_GETSET_LIST_METHODS(DEFINE_SET_SOLVERS_LIST_METHOD, DEFINE_SET_SOLVERS_LIST_METHOD_RETURN)
810
811 /* the slv_get_solvers_*_list methods: all have the same form so it's DEFINE...(D,D) in this case: */
812 DEFINE_GETSET_LIST_METHODS(DEFINE_GET_SOLVERS_LIST_METHOD, DEFINE_GET_SOLVERS_LIST_METHOD)
813
814 #define DEFINE_GET_MASTER_LIST_METHOD(NAME,PROP,TYPE) \
815 struct TYPE **slv_get_master_##NAME##_list(slv_system_t sys){ \
816 if (sys->PROP.master == NULL) { \
817 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_master_" #NAME "_list returning NULL?\n"); \
818 } \
819 return sys->PROP.master; \
820 }
821
822 /* the slv_get_master_*_list are also all of the same form, so DEFINE...(D,D) */
823 DEFINE_GETSET_LIST_METHODS(DEFINE_GET_MASTER_LIST_METHOD,DEFINE_GET_MASTER_LIST_METHOD)
824
825 /*----------------------------------------------------------------------
826 Macros to define:
827
828 slv_get_num_solvers_TYPE
829 slv_get_num_master_TYPE
830 */
831
832 #define DEFINE_SOLVERS_GET_NUM_METHOD(TYPE) \
833 int slv_get_num_solvers_##TYPE(slv_system_t sys){ \
834 if(sys==NULL){ \
835 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"slv_get_num_solvers_" #TYPE " called with NULL system."); \
836 return 0; \
837 } \
838 return sys->TYPE.snum; \
839 }
840
841 #define DEFINE_MASTER_GET_NUM_METHOD(TYPE) \
842 int slv_get_num_master_##TYPE(slv_system_t sys){ \
843 if(sys==NULL){ \
844 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"slv_get_num_master_" #TYPE " called with NULL system."); \
845 return 0; \
846 } \
847 return sys->TYPE.mnum; \
848 }
849
850 #define DEFINE_SLV_METHODS(D) \
851 D(vars) \
852 D(pars) \
853 D(unattached) \
854 D(dvars) \
855 D(disunatt) \
856 D(rels) \
857 D(condrels) \
858 D(objs) \
859 D(logrels) \
860 D(condlogrels) \
861 D(whens) \
862 D(bnds)
863
864 DEFINE_SLV_METHODS(DEFINE_SOLVERS_GET_NUM_METHOD)
865 DEFINE_SLV_METHODS(DEFINE_MASTER_GET_NUM_METHOD)
866
867 void slv_set_obj_relation(slv_system_t sys,struct rel_relation *obj)
868 {
869 if (sys==NULL) {
870 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_obj_relation called with NULL system.\n");
871 return;
872 }
873 sys->obj = obj;
874 }
875
876 struct rel_relation *slv_get_obj_relation(slv_system_t sys)
877 {
878 if (sys==NULL) {
879 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_obj_relation called with NULL system.\n");
880 return NULL;
881 }
882 return sys->obj;
883 }
884
885 void slv_set_obj_variable(slv_system_t sys,struct var_variable *objvar,
886 unsigned maximize)
887 {
888 if (sys==NULL) {
889 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_obj_variable called with NULL system.\n");
890 return;
891 }
892 sys->objvar = objvar;
893 if (objvar!=NULL) {
894 if (maximize) {
895 sys->objvargrad = -1;
896 } else {
897 sys->objvargrad = 1;
898 }
899 } else {
900 sys->objvargrad = 0;
901 }
902 }
903
904 struct var_variable *slv_get_obj_variable(slv_system_t sys)
905 {
906 if (sys==NULL) {
907 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_obj_variable called with NULL system.\n");
908 return NULL;
909 }
910 return sys->objvar;
911 }
912
913 real64 slv_get_obj_variable_gradient(slv_system_t sys)
914 {
915 if (sys==NULL) {
916 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_obj_variable_gradient called with NULL system.\n");
917 return 0.0;
918 }
919 return sys->objvargrad;
920 }
921
922
923 void slv_set_need_consistency(slv_system_t sys, int32 need_consistency)
924 {
925 if (sys==NULL) {
926 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_need_consistency called with NULL system.\n");
927 return;
928 }
929
930 sys->need_consistency = need_consistency;
931 }
932
933
934 int32 slv_need_consistency(slv_system_t sys)
935 {
936 if (sys==NULL) {
937 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_need_consistency called with NULL system.\n");
938 return 0;
939 }
940 return sys->need_consistency;
941 }
942
943 /*----------------------------------------------------------------
944 Macros to define
945
946 slv_count_vars
947 rels
948 dvars
949 logrels
950 whens
951 bnds
952 */
953
954 #define DEFINE_SLV_COUNT_METHOD(NAME,FILTER,TYPE) \
955 static int slv_count_##NAME(FILTER##_filter_t *filter, struct TYPE **list){ \
956 int ret=0; \
957 assert(list!=NULL); \
958 while(*list!=NULL){ \
959 ret += FILTER##_apply_filter(*list,filter); \
960 list++; \
961 } \
962 return ret; \
963 }
964
965 #define DEFINE_SLV_COUNT_METHODS(D) \
966 D(vars,var,var_variable) \
967 D(rels,rel,rel_relation) \
968 D(dvars,dis,dis_discrete) \
969 D(logrels,logrel,logrel_relation) \
970 D(whens,when,w_when) \
971 D(bnds,bnd,bnd_boundary)
972
973 DEFINE_SLV_COUNT_METHODS(DEFINE_SLV_COUNT_METHOD)
974
975 /*--------------------------------------------------------------
976 Methods to define
977 slv_count_solvers_*
978 slv_count_master_*
979 */
980
981 /** This macro automates the declaration of the slv_count_solvers_* methods */
982 #define DEFINE_SLV_COUNT_SOLVER_METHOD(NAME,PROP,TYPE,COUNT) \
983 int slv_count_solvers_ ## NAME ( slv_system_t sys, TYPE ##_filter_t *xxx){ \
984 if(sys==NULL || sys->PROP.solver == NULL || xxx==NULL){ \
985 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_cound_solvers_" #NAME " called with NULL"); \
986 return 0; \
987 } \
988 return slv_count_##COUNT(xxx,sys->PROP.solver); \
989 }
990
991 /** This macro automates the declaration of the slv_count_master_* methods */
992 #define DEFINE_SLV_COUNT_MASTER_METHOD(NAME,PROP,TYPE,COUNT) \
993 int slv_count_master_ ## NAME ( slv_system_t sys, TYPE ##_filter_t *xxx){ \
994 if(sys==NULL || sys->PROP.master == NULL || xxx==NULL){ \
995 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_cound_master_" #NAME " called with NULL"); \
996 return 0; \
997 } \
998 return slv_count_##COUNT(xxx,sys->PROP.master); \
999 }
1000
1001 /** The macro makes all the various * declarations of the methods of type D (master or solvers) */
1002 #define DEFINE_COUNT_METHODS(D) \
1003 D(vars,vars,var,vars) \
1004 D(pars,pars,var,vars) \
1005 D(unattached,unattached,var,vars) \
1006 D(dvars,dvars,dis,dvars) \
1007 D(disunatt,disunatt,dis,dvars) \
1008 D(rels,rels,rel,rels) \
1009 D(condrels,condrels,rel,rels) \
1010 D(objs,objs,rel,rels) \
1011 D(logrels,logrels,logrel,logrels) \
1012 D(condlogrels,condlogrels,logrel,logrels) \
1013 D(whens,whens,when,whens) \
1014 D(bnds,bnds,bnd,bnds)
1015
1016 /** Invoke the DEFINE_COUNT_METHODS macro for SOLVERS methods */
1017 DEFINE_COUNT_METHODS(DEFINE_SLV_COUNT_SOLVER_METHOD)
1018 /** Invoke the DEFINE_COUNT_METHODS macro for MASTER methods */
1019 DEFINE_COUNT_METHODS(DEFINE_SLV_COUNT_MASTER_METHOD)
1020
1021 /*------------------------------------------------------*/
1022
1023 static void printwarning(const char * fname, slv_system_t sys)
1024 {
1025 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,
1026 "%s called with bad registered client (%s).",fname,
1027 slv_solver_name(sys->solver));
1028 }
1029
1030 static void printinfo(slv_system_t sys, const char *rname)
1031 {
1032 if (CF(sys,name) == NULL ) {
1033 ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,
1034 "Client %s does not support function %s\n",
1035 slv_solver_name(sys->solver),rname);
1036 }
1037 }
1038
1039 int slv_eligible_solver(slv_system_t sys)
1040 {
1041 if ( CF(sys,celigible) == NULL ) {
1042 printwarning("slv_eligible_solver",sys);
1043 return 0;
1044 }
1045 return SF(sys,celigible)(sys);
1046 }
1047
1048 int slv_select_solver(slv_system_t sys,int solver){
1049
1050 int status_index;
1051 SlvClientDestroyF *destroy;
1052
1053 if (sys ==NULL) {
1054 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver called with NULL system\n");
1055 return -1;
1056 }
1057 if ( solver >= 0 && solver < NORC ) {
1058 if (sys->ct != NULL && solver != sys->solver) {
1059 destroy = SlvClientsData[sys->solver].cdestroy;
1060 if(destroy!=NULL) {
1061 (destroy)(sys,sys->ct);
1062 sys->ct = NULL;
1063 } else {
1064 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver: 'cdestroy' is undefined on solver '%s' (index %d).",
1065 slv_solver_name(sys->solver), sys->solver);
1066 }
1067 }
1068
1069 if (sys->ct != NULL) {
1070 return sys->solver;
1071 }
1072
1073 status_index = solver;
1074 sys->solver = solver;
1075 if ( CF(sys,ccreate) != NULL) {
1076 sys->ct = SF(sys,ccreate)(sys,&status_index);
1077 } else {
1078 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_select_solver create failed due to bad client %s\n",
1079 slv_solver_name(sys->solver));
1080 return sys->solver;
1081 }
1082 if (sys->ct==NULL) {
1083 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate failed in slv_select_solver\n");
1084 sys->solver = -1;
1085 } else {
1086 if (status_index) {
1087 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate succeeded with warning %d %s\n",
1088 status_index," in slv_select_solver");
1089 }
1090 /* we could do a better job explaining the client warnings... */
1091 sys->solver = solver;
1092 }
1093 } else {
1094 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver: invalid solver index '%d'.",
1095 solver);
1096 return -1;
1097 }
1098 return sys->solver;
1099 }
1100
1101
1102 int slv_switch_solver(slv_system_t sys,int solver)
1103 {
1104 int status_index;
1105
1106 if (sys ==NULL) {
1107 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_switch_solver called with NULL system\n");
1108 return -1;
1109 }
1110 if( solver >= 0 && solver < g_SlvNumberOfRegisteredClients ){
1111 status_index = solver;
1112 sys->solver = solver;
1113 if ( CF(sys,ccreate) != NULL) {
1114 sys->ct = SF(sys,ccreate)(sys,&status_index);
1115 } else {
1116 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_switch_solver create failed due to bad client %s\n",
1117 slv_solver_name(sys->solver));
1118 return sys->solver;
1119 }
1120 if (sys->ct==NULL) {
1121 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"SlvClientCreate failed in slv_switch_solver\n");
1122 sys->solver = -1;
1123 } else {
1124 if (status_index) {
1125 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate succeeded with warning %d %s\n",
1126 status_index," in slv_switch_solver");
1127 }
1128 sys->solver = solver;
1129 }
1130 } else {
1131 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_switch_solver called with unknown client (%d)\n",solver);
1132 return -1;
1133 }
1134 return sys->solver;
1135 }
1136
1137 void slv_set_char_parameter(char **cp, char *newvalue)
1138 {
1139 if (cp != NULL) {
1140 if (*cp != NULL) {
1141 ascfree(*cp);
1142 }
1143 *cp = ascstrdup(newvalue);
1144 }
1145 }
1146
1147 void slv_destroy_parms(slv_parameters_t *p) {
1148 int32 i,j;
1149 for (i = 0; i < p->num_parms; i++) {
1150 switch(p->parms[i].type) {
1151 case char_parm:
1152 ascfree(p->parms[i].info.c.value);
1153 for (j = 0; j < p->parms[i].info.c.high; j++) {
1154 ascfree(p->parms[i].info.c.argv[j]);
1155 }
1156 ascfree(p->parms[i].info.c.argv);
1157 /* FALL THROUGH */
1158 case int_parm:
1159 case bool_parm:
1160 case real_parm:
1161 ascfree(p->parms[i].name);
1162 ascfree(p->parms[i].interface_label);
1163 ascfree(p->parms[i].description);
1164 break;
1165 default:
1166 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Unrecognized parameter type in slv_destroy_parms\n");
1167 }
1168 }
1169 if (p->parms && p->dynamic_parms) {
1170 ascfree(p->parms);
1171 }
1172 }
1173
1174 int32 slv_define_parm(slv_parameters_t *p,
1175 enum parm_type type,
1176 char *name,
1177 char *interface_label,
1178 char *description,
1179 union parm_arg value,
1180 union parm_arg low,
1181 union parm_arg high,
1182 int32 display)
1183 {
1184 int32 len,length,i, err=1;
1185 if (p == NULL) {
1186 return -1;
1187 }
1188 length = p->num_parms;
1189
1190 switch (type) {
1191 case int_parm:
1192 err = 0;
1193 p->parms[length].info.i.value = value.argi;
1194 p->parms[length].info.i.low = low.argi;
1195 p->parms[length].info.i.high = high.argi;
1196 break;
1197
1198 case bool_parm:
1199 err = 0;
1200 p->parms[length].info.b.value = value.argb;
1201 p->parms[length].info.b.low = low.argb;
1202 p->parms[length].info.b.high = high.argb;
1203 break;
1204
1205 case real_parm:
1206 err = 0;
1207 p->parms[length].info.r.value = value.argr;
1208 p->parms[length].info.r.low = low.argr;
1209 p->parms[length].info.r.high = high.argr;
1210 break;
1211
1212 case char_parm:
1213 err = 0;
1214 p->parms[length].info.c.argv =
1215 (char **)ascmalloc(high.argi*sizeof(char *));
1216 for (i = 0; i < high.argi; i++) {
1217 len = strlen(low.argv[i]);
1218 p->parms[length].info.c.argv[i] =(char *)ascmalloc(len+1*sizeof(char));
1219 strcpy(p->parms[length].info.c.argv[i],low.argv[i]);
1220 }
1221
1222 p->parms[length].info.c.value =
1223 (char *)ascmalloc(strlen(value.argc)+1*sizeof(char));
1224 strcpy(p->parms[length].info.c.value,value.argc);
1225
1226 p->parms[length].info.c.high = high.argi;
1227 break;
1228
1229 default:
1230 return -1;
1231 }
1232 if (!err) {
1233 p->parms[length].type = type;
1234 p->parms[length].number = length;
1235
1236 len = strlen(name);
1237 p->parms[length].name = (char *)ascmalloc(len+1*sizeof(char));
1238 strcpy(p->parms[length].name,name);
1239
1240 len = strlen(interface_label);
1241 p->parms[length].interface_label = (char *)ascmalloc(len+1*sizeof(char));
1242 strcpy(p->parms[length].interface_label,interface_label);
1243
1244 len = strlen(description);
1245 p->parms[length].description = (char *)ascmalloc(len+1*sizeof(char));
1246 strcpy(p->parms[length].description,description);
1247
1248 p->parms[length].display = display;
1249 } else {
1250 p->parms[length].type = -1;
1251 }
1252 p->num_parms++;
1253 return p->num_parms;
1254 }
1255
1256 int slv_get_selected_solver(slv_system_t sys)
1257 {
1258 if (sys!=NULL) return sys->solver;
1259 return -1;
1260 }
1261
1262 int32 slv_get_default_parameters(int index,
1263 slv_parameters_t *parameters)
1264 {
1265 if (index >= 0 && index < NORC) {
1266 if ( SlvClientsData[index].getdefparam == NULL ) {
1267 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_default_parameters called with parameterless index\n");
1268 return 0;
1269 } else {
1270 /* send NULL system when setting up interface */
1271 (SlvClientsData[index].getdefparam)(NULL,NULL,parameters);
1272 return 1;
1273 }
1274 } else {
1275 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_default_parameters called with unregistered index\n");
1276 return 0;
1277 }
1278 }
1279
1280 /*-----------------------------------------------------------
1281 These macros do some more elimination of repetition. Here we're
1282 trying to replace some more complex 'method-like' calls on
1283 slv_system_t:
1284
1285 These macros use macro-argument-concatenation and macro stringification.
1286 Verified that the former works with Visual C++:
1287 getlinso://www.codeproject.com/macro/metamacros.asp
1288 */
1289
1290 /** Define a method like 'void slv_METHODNAME(sys)' */
1291 #define DEFINE_SLV_PROXY_METHOD_VOID(METHOD) \
1292 void slv_ ## METHOD (slv_system_t sys){ \
1293 if(CF(sys,METHOD)==NULL){ \
1294 printwarning(#METHOD,sys); \
1295 return; \
1296 } \
1297 SF(sys,METHOD)(sys,sys->ct); \
1298 }
1299
1300 /** Define a method like 'RETURNTYPE slv_METHOD(sys)'; */
1301 #define DEFINE_SLV_PROXY_METHOD(METHOD,PROP,RETTYPE) \
1302 RETTYPE slv_ ## METHOD (slv_system_t sys){ \
1303 if(CF(sys,PROP)==NULL){ \
1304 printwarning(#METHOD,sys); \
1305 return; \
1306 } \
1307 return SF(sys,PROP)(sys,sys->ct); \
1308 }
1309
1310 /** Define a method like 'void slv_METHOD(sys,TYPE PARAMNAME)'; */
1311 #define DEFINE_SLV_PROXY_METHOD_PARAM(METHOD,PROP,PARAMTYPE,PARAMNAME) \
1312 void slv_ ## METHOD (slv_system_t sys, PARAMTYPE PARAMNAME){ \
1313 if(CF(sys,PROP)==NULL){ \
1314 printwarning(#METHOD,sys); \
1315 return; \
1316 } \
1317 SF(sys,PROP)(sys,sys->ct, PARAMNAME); \
1318 }
1319
1320 DEFINE_SLV_PROXY_METHOD_PARAM(get_parameters,getparam,slv_parameters_t*,parameters);
1321
1322 void slv_set_parameters(slv_system_t sys,slv_parameters_t *parameters)
1323 {
1324 if ( CF(sys,setparam) == NULL ) {
1325 printwarning("slv_set_parameters",sys);
1326 return;
1327 }
1328 if (parameters->whose != sys->solver) {
1329 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,
1330 "slv_set_parameters can give parameters from one client to a different client.");
1331 return;
1332 }
1333 SF(sys,setparam)(sys,sys->ct,parameters);
1334 }
1335
1336 DEFINE_SLV_PROXY_METHOD_PARAM(get_status,getstatus,slv_status_t*,status);
1337 DEFINE_SLV_PROXY_METHOD(get_linsolv_sys, getlinsol, linsol_system_t);
1338 DEFINE_SLV_PROXY_METHOD(get_sys_mtx, getsysmtx, mtx_matrix_t);
1339 DEFINE_SLV_PROXY_METHOD(get_linsolqr_sys, getlinsys, linsolqr_system_t);
1340 DEFINE_SLV_PROXY_METHOD_PARAM(dump_internals,dumpinternals,int,level);
1341 DEFINE_SLV_PROXY_METHOD_VOID(presolve);
1342 DEFINE_SLV_PROXY_METHOD_VOID(resolve);
1343 DEFINE_SLV_PROXY_METHOD_VOID(iterate);
1344 DEFINE_SLV_PROXY_METHOD_VOID(solve);
1345
1346 /*-----------------------------------------------------------*/
1347
1348 SlvClientToken slv_get_client_token(slv_system_t sys)
1349 {
1350 if (sys==NULL) {
1351 FPRINTF(stderr,"slv_get_client_token called with NULL system.\n");
1352 return NULL;
1353 }
1354 return sys->ct;
1355 }
1356
1357
1358 void slv_set_client_token(slv_system_t sys, SlvClientToken ct)
1359 {
1360 if (sys==NULL) {
1361 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_client_token called with NULL system.\n");
1362 return;
1363 }
1364 sys->ct = ct;
1365 }
1366
1367 void slv_set_solver_index(slv_system_t sys, int solver)
1368 {
1369 if (sys==NULL) {
1370 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solver_index called with NULL system.\n");
1371 return;
1372 }
1373 sys->solver = solver;
1374 }
1375
1376 /*********************************************************************\
1377 unregistered client functions that need to go elsewhere(other files).
1378 hereunder are utility calls which are unstandardized
1379 \*********************************************************************/
1380
1381 boolean slv_change_basis(slv_system_t sys, int32 var, mtx_range_t *rng)
1382 {
1383 (void)sys;
1384 (void)var;
1385 (void)rng;
1386 Asc_Panic(2, "slv_change_basis", "fix me");
1387 return 0;
1388 }
1389
1390 /*
1391 * This routine is provided as the start of some report generation
1392 * capabilities. It operates off the main solve system and
1393 * writes out the relation residuals and variable values for
1394 * the entire problem to the named file.
1395 * Isn't very bright.
1396 */
1397
1398 void slv_print_output(FILE *out, slv_system_t sys)
1399 {
1400 struct rel_relation **rp;
1401 struct var_variable **vp;
1402 int nrels, nvars,c;
1403
1404 vp = slv_get_master_var_list(sys);
1405 nvars = slv_get_num_master_vars(sys);
1406 FPRINTF(out,"%-6s %-12s\n",
1407 "INDEX","LEVEL");
1408 for (c=0; c<nvars; c++) {
1409 FPRINTF(out," % -6d % -12.8e\n",c, var_value(vp[c]));
1410 }
1411 PUTC('\n',out);
1412
1413 rp = slv_get_master_rel_list(sys);
1414 nrels = slv_get_num_master_rels(sys);
1415 FPRINTF(out,"%-6s %-12s\n",
1416 "INDEX","RESDUAL");
1417 for (c=0; c<nrels; c++) {
1418 FPRINTF(out," % -6d % -12.8e\n",c, rel_residual(rp[c]));
1419 }
1420 }
1421
1422 int32 slv_obj_select_list(slv_system_t sys,int32 **rip)
1423 {
1424 int32 len,count,i, *ra;
1425 static rel_filter_t rfilter;
1426 struct rel_relation **rlist=NULL;
1427 len = slv_get_num_solvers_objs(sys);
1428 ra = *rip = (int32 *)ascmalloc((len+1)*sizeof(int32 *));
1429 rfilter.matchbits = (REL_INCLUDED);
1430 rfilter.matchvalue =(REL_INCLUDED);
1431 rlist = slv_get_solvers_obj_list(sys);
1432 count = 0;
1433 for (i = 0; i < len; i++) {
1434 if (rel_apply_filter(rlist[i],&rfilter)) {
1435 ra[count] = i;
1436 count++;
1437 }
1438 }
1439 ra[count] = -1;
1440 return count;
1441 }
1442
1443 int32 slv_get_obj_num(slv_system_t sys)
1444 {
1445 int32 len,i;
1446 struct rel_relation *obj;
1447 struct rel_relation **rlist=NULL;
1448 len = slv_get_num_solvers_objs(sys);
1449 rlist = slv_get_solvers_obj_list(sys);
1450 obj = slv_get_obj_relation(sys);
1451 if (obj != NULL) {
1452 for (i = 0; i < len; i++) {
1453 if (rlist[i] == obj) {
1454 return i;
1455 }
1456 }
1457 }
1458 return -1;
1459 }
1460
1461 int32 slv_near_bounds(slv_system_t sys,real64 epsilon,
1462 int32 **vip)
1463 {
1464 int32 len,i, *va, index;
1465 real64 comp;
1466 static var_filter_t vfilter;
1467 struct var_variable **vlist=NULL;
1468 len = slv_get_num_solvers_vars(sys);
1469 va = *vip = (int32 *)ascmalloc((2*len+2)*sizeof(int32 *));
1470 vfilter.matchbits = (VAR_FIXED | VAR_INCIDENT | VAR_SVAR | VAR_ACTIVE);
1471 vfilter.matchvalue = (VAR_INCIDENT | VAR_SVAR | VAR_ACTIVE);
1472 vlist = slv_get_solvers_var_list(sys);
1473 va[0] = va[1] = 0;
1474 index = 2;
1475 for (i = 0; i < len; i++) {
1476 if (var_apply_filter(vlist[i],&vfilter)) {
1477 comp = (var_value(vlist[i]) - var_lower_bound(vlist[i]))
1478 / var_nominal(vlist[i]);
1479 if (comp < epsilon) {
1480 va[index] = i;
1481 index++;
1482 va[0]++;
1483 }
1484 }
1485 }
1486 for (i = 0; i < len; i++) {
1487 if (var_apply_filter(vlist[i],&vfilter)) {
1488 comp = (var_upper_bound(vlist[i]) - var_value(vlist[i]))
1489 / var_nominal(vlist[i]);
1490 if (comp < epsilon) {
1491 va[index] = i;
1492 index++;
1493 va[1]++;
1494 }
1495 }
1496 }
1497 return index - 2;
1498 }
1499
1500 int32 slv_far_from_nominals(slv_system_t sys,real64 bignum,
1501 int32 **vip)
1502 {
1503 int32 len,i, *va, index;
1504 real64 comp;
1505 static var_filter_t vfilter;
1506 struct var_variable **vlist=NULL;
1507 len = slv_get_num_solvers_vars(sys);
1508 va = *vip = (int32 *)ascmalloc((len+1)*sizeof(int32 *));
1509 vfilter.matchbits = (VAR_FIXED | VAR_INCIDENT | VAR_SVAR | VAR_ACTIVE);
1510 vfilter.matchvalue = (VAR_INCIDENT | VAR_SVAR | VAR_ACTIVE);
1511 vlist = slv_get_solvers_var_list(sys);
1512 index = 0;
1513 for (i = 0; i < len; i++) {
1514 if (var_apply_filter(vlist[i],&vfilter)) {
1515 comp = fabs(var_value(vlist[i]) - var_nominal(vlist[i]))
1516 / var_nominal(vlist[i]);
1517 if (comp > bignum) {
1518 va[index] = i;
1519 index++;
1520 }
1521 }
1522 }
1523 return index;
1524 }
1525

Properties

Name Value
svn:executable *

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