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

Properties

Name Value
svn:executable *

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