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

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