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

Properties

Name Value
svn:executable *

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