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

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