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

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