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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:executable *

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