generic/solver/solver.c

/*  ASCEND modelling environment
    Copyright (C) 2007 Carnegie Mellon University

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2, or (at your option)
    any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330,
    Boston, MA 02111-1307, USA.
*//**
    @file
    Solver API for ASCEND, for solving NLA, LP, NLP, MINLP problems (anything
    without derivatives).
*//*
    by John Pye, May 2006
    based on parts of slv_stdcalls.c, modified to provide dynamic loading
    support, and aiming to improve the separation of 'system' and 'solver',
    the former being a collection of equations and variables, and the latter
    being all the methods and data storage that allows a solution to be
    found and reported.
*/

#include "solver.h"

#include <system/system_impl.h>
#include <general/list.h>
#include <utilities/ascMalloc.h>
#include <utilities/ascPanic.h>
#include <compiler/packages.h>

/**
    Local function that holds the list of available solvers. The value 
    returned is NOT owned by the called.

    @param free_space if 0, call as normal. if 1, free the list and maybe do some
    cleaning up etc. Should be called whenever a simulation is destroyed.
*/
static struct gl_list_t *solver_get_list(int free_space){
    static int init = 0;
    static struct gl_list_t *L;
    if(free_space){
        if(init && L)ASC_FREE(L);
        init = 0;
        return NULL;
    }
    if(!init){
        L = gl_create(10);
        init = 1;
    }
    return L;
}

/**
    Return gl_list of SlvFunctionsT. C++ will use this to produce a
    nice little list of integrator names that can be used in Python :-/
*/
const struct gl_list_t *solver_get_engines(){
    return solver_get_list(0);
}

const SlvFunctionsT *solver_engine(const int number){
    const struct gl_list_t *L = solver_get_engines();
    int i;
    const SlvFunctionsT *S, *Sfound=NULL;
    /* CONSOLE_DEBUG("Searching for solver #%d in list of %d solvers",number,gl_length(L)); */
    for(i=1; i <= gl_length(L); ++i){
        S = gl_fetch(L,i);
        /* CONSOLE_DEBUG("Looking at %s (%d)",S->name,S->number); */
        if(S->number==number){
            /* CONSOLE_DEBUG("Match!"); */
            Sfound = S;
            break;
        }
    }
    /* CONSOLE_DEBUG("Returning %d",Sfound); */
    return Sfound;
}

const SlvFunctionsT *solver_engine_named(const char *name){
    const struct gl_list_t *L = solver_get_engines();
    int i;
    const SlvFunctionsT *S, *Sfound=NULL;
    for(i=1; i <= gl_length(L); ++i){
        S = gl_fetch(L,i);
        if(strcmp(S->name,name)==0){
            Sfound = S;
            break;
        }
    }
    return Sfound;
}   

int slv_lookup_client(const char *name){
#if 0 
    int i;

    if(name == NULL)return -1;

    for(i = 0; i < NORC; i++) {
        if(strcmp( SCD(i).name, name)==0) {
            return i;
        }
    }
    return -1;
#endif
    const struct gl_list_t *L = solver_get_engines();
    int i;
    const SlvFunctionsT *S, *Sfound=NULL;
    for(i=1; i <= gl_length(L); ++i){
        S = gl_fetch(L,i);
        if(strcmp(S->name,name)==0){
            Sfound = S;
            break;
        }
    }
    if(Sfound){
        return S->number;
    }else{
        ERROR_REPORTER_HERE(ASC_PROG_ERR,"Invalid engine name '%s'",name);
        return -1;
    }
}


/** 
    Register a new solver.
    
    @TODO This needs work still, particularly of the dynamic loading
    sort. it would be good if here we farmed out the dynamic loading
    to another file so we don't have to crap this one all up.

    old args:
(SlvRegistration registerfunc, CONST char *func
        ,CONST char *file, int *new_client_id
*/
int solver_register(const SlvFunctionsT *solver){
#if 0
    int status;

    status = registerfunc(&( SlvClientsData[NORC]));
    if (!status) { /* ok */
        SlvClientsData[NORC].number = NORC;
        *new_client_id = NORC;
        NORC++;
    } else {
        *new_client_id = -2;
        ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"Client %d registration failure (%d)!",NORC,status);
    }
    return status;
#endif

    /* get the current list of registered engines */
    const struct gl_list_t *L;
    L = solver_get_engines();

#if 0
    CONSOLE_DEBUG("REGISTERING SOLVER");
    CONSOLE_DEBUG("There were %lu registered solvers", gl_length(solver_get_list(0)));
#endif

    int i;
    const SlvFunctionsT *S;
    for(i=1; i < gl_length(L); ++i){
        S = (const SlvFunctionsT *)gl_fetch(L,i);
        if(strcmp(solver->name,S->name)==0){
            ERROR_REPORTER_HERE(ASC_USER_WARNING,"Solver with name '%s' is already registered",solver->name);
            return 0;
        }
        if(solver->number == S->number){
            ERROR_REPORTER_HERE(ASC_USER_WARNING,"Solver with ID '%d' is already registered",solver->number);
            return 0;
        }
    }

#if 1
    CONSOLE_DEBUG("Adding engine '%s'",solver->name);
#endif

    gl_append_ptr(L,(SlvFunctionsT *)solver);
    
#if 1
    CONSOLE_DEBUG("There are now %lu registered solvers", gl_length(solver_get_list(0)));
#endif
    return 0;
}


/*------------------------------------------------------------------------------
  SOLVER REGISTRATION
*/

/* rewrote this stuff to get rid of all the #ifdefs -- JP */

struct StaticSolverRegistration{
    const char *importname;
};

/*
    The names here are only used to provide information in the case where
    solver registration fails. The definitive solver names are in the slv*.c
    files.
*/
static const struct StaticSolverRegistration slv_reg[]={
    {"qrslv"}
    ,{"conopt"}
    ,{"lrslv"}
    ,{"cmslv"}
/*  ,{"ipopt"} */
    ,{NULL}
#if 0
/*  {0,"SLV",&slv0_register} */
/*  ,{0,"MINOS",&slv1_register} */
/*  ,{0,"CSLV",&slv4_register} */
/*  ,{0,"LSSLV",&slv5_register} */
/*  ,{0,"MPS",&slv6_register} */
/*  ,{0,"NGSLV",&slv7_register} */
/*  ,{0,"OPTSQP",&slv2_register} */
#endif
};

int SlvRegisterStandardClients(void){
    int nclients = 0;
    //int newclient=0;
    int error;
    int i;

    /* CONSOLE_DEBUG("REGISTERING STANDARD SOLVER ENGINES"); */
    for(i=0; slv_reg[i].importname!=NULL;++i){
        error = package_load(slv_reg[i].importname,NULL);
        if(error){
            ERROR_REPORTER_HERE(ASC_PROG_ERR
                ,"Unable to register solver '%s' (error %d)."
                ,slv_reg[i].importname,error
            );
        }else{
            CONSOLE_DEBUG("Solver '%s' registered OK",slv_reg[i].importname);
            nclients++;
        }
    }
  return nclients;
}

/*------------------------------------------------------*/

static void printwarning(const char * fname, slv_system_t sys)
{
  ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,
    "%s called with bad registered client (%s).",fname,
    slv_solver_name(slv_get_selected_solver(sys)));
}

static void printinfo(slv_system_t sys, const char *rname){
  asc_assert(sys->internals);
  if(sys->internals->name) {
    ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,
      "Client %s does not support function '%s'.",
      sys->internals->name,rname);
  }
}

/*-----------------------------------------------------------
    These macros do some more elimination of repetition. Here we're
    trying to replace some more complex 'method-like' calls on
    slv_system_t:

    These macros use macro-argument-concatenation and macro stringification.
    Verified that the former works with Visual C++.
    http://www.codeproject.com/macro/metamacros.asp
*/

/** Define a method like 'void slv_METHODNAME(sys)' */
#define DEFINE_SLV_PROXY_METHOD_VOID(METHOD) \
    void slv_ ## METHOD (slv_system_t sys){ \
        if(CF(sys,METHOD)==NULL){ \
            printwarning(#METHOD,sys); \
            return; \
        } \
        SF(sys,METHOD)(sys,sys->ct); \
    }

/** Define a method like 'RETURNTYPE slv_METHOD(sys)'; */
#define DEFINE_SLV_PROXY_METHOD(METHOD,PROP,RETTYPE,ERRVAL) \
    RETTYPE slv_ ## METHOD (slv_system_t sys){ \
        /* CONSOLE_DEBUG("slv_" #METHOD);*/ \
        asc_assert(sys->internals); \
        /*CONSOLE_DEBUG("internals OK");*/ \
        if(sys->internals->PROP==NULL){ \
            /*CONSOLE_DEBUG("method is NULL");*/ \
            printinfo(sys, #METHOD); \
            return ERRVAL; \
        } \
        /*CONSOLE_DEBUG("running method " #PROP " in solver %d",sys->internals->number);*/ \
        return (sys->internals->PROP)(sys,sys->ct); \
    }

/** Define a method like 'void slv_METHOD(sys,TYPE PARAMNAME)'; */
#define DEFINE_SLV_PROXY_METHOD_PARAM(METHOD,PROP,PARAMTYPE,PARAMNAME) \
    void slv_ ## METHOD (slv_system_t sys, PARAMTYPE PARAMNAME){ \
        if(!sys->internals || !sys->internals->PROP){ \
            printwarning(#METHOD,sys); \
            return; \
        } \
        (sys->internals->PROP)(sys,sys->ct, PARAMNAME); \
    }

DEFINE_SLV_PROXY_METHOD_PARAM(get_parameters,get_parameters,slv_parameters_t*,parameters) /*;*/

void slv_set_parameters(slv_system_t sys,slv_parameters_t *parameters)
{
  asc_assert(sys->internals);
  if(sys->internals->setparam == NULL ) {
    printwarning("slv_set_parameters",sys);
    return;
  }
  if (parameters->whose != sys->solver) {
    ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,
        "slv_set_parameters cannot pass parameters from one solver to a"
        " another.");
    return;
  }
  (sys->internals->setparam)(sys,sys->ct,parameters);
}

int slv_get_status(slv_system_t sys, slv_status_t *status){
    static const SlvFunctionsT *lastsolver = 0;
    if(!sys->internals)return -1;
    if(sys->internals->getstatus==NULL){
        if(lastsolver==0 || lastsolver != sys->internals){
            printinfo(sys,"get_status");
            lastsolver = sys->internals;
        }
        return -1;
    }
    return (sys->internals->getstatus)(sys,sys->ct,status);
}

DEFINE_SLV_PROXY_METHOD_PARAM(dump_internals,dumpinternals,int,level) /*;*/

DEFINE_SLV_PROXY_METHOD(get_linsolqr_sys, getlinsys, linsolqr_system_t, NULL) /*;*/

DEFINE_SLV_PROXY_METHOD(get_sys_mtx, get_sys_mtx, mtx_matrix_t, NULL) /*;*/
DEFINE_SLV_PROXY_METHOD(presolve,presolve,int,-1) /*;*/
DEFINE_SLV_PROXY_METHOD(resolve,resolve,int,-1) /*;*/
DEFINE_SLV_PROXY_METHOD(iterate,iterate,int,-1) /*;*/
DEFINE_SLV_PROXY_METHOD(solve,solve,int,-1) /*;*/

int slv_eligible_solver(slv_system_t sys)
{
  asc_assert(sys->internals);
  if(sys->internals->celigible == NULL ) {
    printwarning("slv_eligible_solver",sys);
    return 0;
  }
  return (sys->internals->celigible)(sys);
}

//-------------

    
int slv_select_solver(slv_system_t sys,int solver){

  int status_index;
  SlvClientDestroyF *destroy;
  const SlvFunctionsT *S;

  if(sys ==NULL) {
    ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver called with NULL system.");
    return -1;
  }

  /* CONSOLE_DEBUG("CHECKING FOR SOLVER %d", solver); */

  if(solver_engine(solver)){
    /* CONSOLE_DEBUG("SOLVER FOUND"); */
    if(sys->ct != NULL && solver != sys->solver){
      /* CONSOLE_DEBUG("DIFFERENT SOLVER"); */
      //CONSOLE_DEBUG("g_SlvNumberOfRegisteredClients = %d, sys->solver = %d", g_SlvNumberOfRegisteredClients, sys->solver);
      asc_assert(sys->solver >= -1);
      //asc_assert(g_SlvNumberOfRegisteredClients > 0);
      //asc_assert(sys->solver < g_SlvNumberOfRegisteredClients);
      S = solver_engine(sys->solver);
      destroy = S->cdestroy;
      if(destroy!=NULL) {
        (destroy)(sys,sys->ct);
        sys->ct = NULL;
      }else{
        ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver: 'cdestroy' is undefined on solver '%s' (index %d).",
          S->name, sys->solver);
      }
    }

    /* CONSOLE_DEBUG("PREVIOUS SOLVER IS CLEAR"); */

    if(sys->ct != NULL) {
      CONSOLE_DEBUG("CURRENT SOLVER UNCHANGED");
      return sys->solver;
    }

    status_index = solver;
    sys->solver = solver;
    sys->internals = solver_engine(solver);
    if(sys->internals->ccreate != NULL){
      sys->ct = (sys->internals->ccreate)(sys,&status_index);
    }else{
      ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_select_solver create failed due to bad client '%s'.",
        slv_solver_name(sys->solver));
      return sys->solver;
    }
    if(sys->ct==NULL){
      ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate failed in slv_select_solver.");
      sys->solver = -1;
    }else{
      if (status_index){
        ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate succeeded with warning %d %s.",
          status_index," in slv_select_solver");
      }
      /* we could do a better job explaining the client warnings... */
      sys->solver = solver;
    }
  }else{
    ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver: invalid solver index '%d'.",
      solver);
    return -1;
  }
  return sys->solver;
}

/**
    @TODO looks buggy
*/
int slv_switch_solver(slv_system_t sys,int solver)
{
  int status_index;

  if(sys ==NULL){
    ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_switch_solver called with NULL system.");
    return -1;
  }

  /* CONSOLE_DEBUG("CHECKING FOR SOLVER %d", solver); */

  if(solver_engine(solver)){
    status_index = solver;
    sys->solver = solver;
    sys->internals = solver_engine(solver);
    CONSOLE_DEBUG("SWITCHING TO SOLVER '%s'",sys->internals->name);
    if(sys->internals->ccreate != NULL) {
      sys->ct = (sys->internals->ccreate)(sys,&status_index);
    } else {
      ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_switch_solver create failed due to bad client '%s'.",
         slv_solver_name(sys->solver));
      return sys->solver;
    }
    if (sys->ct==NULL) {
      ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"SlvClientCreate failed in slv_switch_solver.");
      sys->solver = -1;
    }else{
      if (status_index) {
        ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate succeeded with warning %d %s.",
           status_index," in slv_switch_solver");
      }
      sys->solver = solver;
    }
  }else{
    ERROR_REPORTER_HERE(ASC_PROG_WARNING,"Unknown client '%d'.",solver);
    return -1;
  }
  return sys->solver;
}

/*--------------------------------*/

int slv_get_selected_solver(slv_system_t sys){
  if (sys!=NULL) return sys->solver;
  return -1;
}


int32 slv_get_default_parameters(int sindex,
                slv_parameters_t *parameters)
{
  SlvFunctionsT *S;
  S = solver_engine(sindex);
  if(S){
    if(S->getdefparam == NULL ) {
      ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_default_parameters called with parameterless index.");
      return 0;
    }else{
      /* send NULL system when setting up interface */
      (S->getdefparam)(NULL,NULL,parameters);
      return 1;
    }
  }else{
    ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_default_parameters called with unregistered index.");
    return 0;
  }
}


/*-----------------------------------------------------------*/

SlvClientToken slv_get_client_token(slv_system_t sys)
{
  if (sys==NULL) {
    FPRINTF(stderr,"slv_get_client_token called with NULL system.");
    return NULL;
  }
  return sys->ct;
}


void slv_set_client_token(slv_system_t sys, SlvClientToken ct)
{
  if (sys==NULL) {
    ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_client_token called with NULL system.");
    return;
  }
  sys->ct = ct;
}

void slv_set_solver_index(slv_system_t sys, int solver)
{
  if (sys==NULL) {
    ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solver_index called with NULL system.");
    return;
  }
  sys->solver = solver;
  sys->internals = solver_engine(solver);
}


const char *slv_solver_name(int sindex){
  static char errname[] = "ErrorSolver";
  const SlvFunctionsT *S = solver_engine(sindex);
  if(S!=NULL){
    if(S->name == NULL) {
      ERROR_REPORTER_HERE(ASC_PROG_WARNING,"unnamed solver: index='%d'",sindex);
      return errname;
    }else{
      return S->name;
    }
  }else{
    ERROR_REPORTER_HERE(ASC_PROG_ERROR,"invalid solver index '%d'", sindex);
    return errname;
  }
}

1	/* ASCEND modelling environment
2	Copyright (C) 2007 Carnegie Mellon University
3
4	This program is free software; you can redistribute it and/or modify
5	it under the terms of the GNU General Public License as published by
6	the Free Software Foundation; either version 2, or (at your option)
7	any later version.
8
9	This program is distributed in the hope that it will be useful,
10	but WITHOUT ANY WARRANTY; without even the implied warranty of
11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12	GNU General Public License for more details.
13
14	You should have received a copy of the GNU General Public License
15	along with this program; if not, write to the Free Software
16	Foundation, Inc., 59 Temple Place - Suite 330,
17	Boston, MA 02111-1307, USA.
18	//*
19	@file
20	Solver API for ASCEND, for solving NLA, LP, NLP, MINLP problems (anything
21	without derivatives).
22	//
23	by John Pye, May 2006
24	based on parts of slv_stdcalls.c, modified to provide dynamic loading
25	support, and aiming to improve the separation of 'system' and 'solver',
26	the former being a collection of equations and variables, and the latter
27	being all the methods and data storage that allows a solution to be
28	found and reported.
29	*/
30
31	#include "solver.h"
32
33	#include <system/system_impl.h>
34	#include <general/list.h>
35	#include <utilities/ascMalloc.h>
36	#include <utilities/ascPanic.h>
37	#include <compiler/packages.h>
38
39	/**
40	Local function that holds the list of available solvers. The value
41	returned is NOT owned by the called.
42
43	@param free_space if 0, call as normal. if 1, free the list and maybe do some
44	cleaning up etc. Should be called whenever a simulation is destroyed.
45	*/
46	static struct gl_list_t *solver_get_list(int free_space){
47	static int init = 0;
48	static struct gl_list_t *L;
49	if(free_space){
50	if(init && L)ASC_FREE(L);
51	init = 0;
52	return NULL;
53	}
54	if(!init){
55	L = gl_create(10);
56	init = 1;
57	}
58	return L;
59	}
60
61	/**
62	Return gl_list of SlvFunctionsT. C++ will use this to produce a
63	nice little list of integrator names that can be used in Python :-/
64	*/
65	const struct gl_list_t *solver_get_engines(){
66	return solver_get_list(0);
67	}
68
69	const SlvFunctionsT *solver_engine(const int number){
70	const struct gl_list_t *L = solver_get_engines();
71	int i;
72	const SlvFunctionsT S, Sfound=NULL;
73	/* CONSOLE_DEBUG("Searching for solver #%d in list of %d solvers",number,gl_length(L)); */
74	for(i=1; i <= gl_length(L); ++i){
75	S = gl_fetch(L,i);
76	/* CONSOLE_DEBUG("Looking at %s (%d)",S->name,S->number); */
77	if(S->number==number){
78	/* CONSOLE_DEBUG("Match!"); */
79	Sfound = S;
80	break;
81	}
82	}
83	/* CONSOLE_DEBUG("Returning %d",Sfound); */
84	return Sfound;
85	}
86
87	const SlvFunctionsT solver_engine_named(const char name){
88	const struct gl_list_t *L = solver_get_engines();
89	int i;
90	const SlvFunctionsT S, Sfound=NULL;
91	for(i=1; i <= gl_length(L); ++i){
92	S = gl_fetch(L,i);
93	if(strcmp(S->name,name)==0){
94	Sfound = S;
95	break;
96	}
97	}
98	return Sfound;
99	}
100
101	int slv_lookup_client(const char *name){
102	#if 0
103	int i;
104
105	if(name == NULL)return -1;
106
107	for(i = 0; i < NORC; i++) {
108	if(strcmp( SCD(i).name, name)==0) {
109	return i;
110	}
111	}
112	return -1;
113	#endif
114	const struct gl_list_t *L = solver_get_engines();
115	int i;
116	const SlvFunctionsT S, Sfound=NULL;
117	for(i=1; i <= gl_length(L); ++i){
118	S = gl_fetch(L,i);
119	if(strcmp(S->name,name)==0){
120	Sfound = S;
121	break;
122	}
123	}
124	if(Sfound){
125	return S->number;
126	}else{
127	ERROR_REPORTER_HERE(ASC_PROG_ERR,"Invalid engine name '%s'",name);
128	return -1;
129	}
130	}
131
132
133	/**
134	Register a new solver.
135
136	@TODO This needs work still, particularly of the dynamic loading
137	sort. it would be good if here we farmed out the dynamic loading
138	to another file so we don't have to crap this one all up.
139
140	old args:
141	(SlvRegistration registerfunc, CONST char *func
142	,CONST char file, int new_client_id
143	*/
144	int solver_register(const SlvFunctionsT *solver){
145	#if 0
146	int status;
147
148	status = registerfunc(&( SlvClientsData[NORC]));
149	if (!status) { /* ok */
150	SlvClientsData[NORC].number = NORC;
151	*new_client_id = NORC;
152	NORC++;
153	} else {
154	*new_client_id = -2;
155	ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"Client %d registration failure (%d)!",NORC,status);
156	}
157	return status;
158	#endif
159
160	/* get the current list of registered engines */
161	const struct gl_list_t *L;
162	L = solver_get_engines();
163
164	#if 0
165	CONSOLE_DEBUG("REGISTERING SOLVER");
166	CONSOLE_DEBUG("There were %lu registered solvers", gl_length(solver_get_list(0)));
167	#endif
168
169	int i;
170	const SlvFunctionsT *S;
171	for(i=1; i < gl_length(L); ++i){
172	S = (const SlvFunctionsT *)gl_fetch(L,i);
173	if(strcmp(solver->name,S->name)==0){
174	ERROR_REPORTER_HERE(ASC_USER_WARNING,"Solver with name '%s' is already registered",solver->name);
175	return 0;
176	}
177	if(solver->number == S->number){
178	ERROR_REPORTER_HERE(ASC_USER_WARNING,"Solver with ID '%d' is already registered",solver->number);
179	return 0;
180	}
181	}
182
183	#if 1
184	CONSOLE_DEBUG("Adding engine '%s'",solver->name);
185	#endif
186
187	gl_append_ptr(L,(SlvFunctionsT *)solver);
188
189	#if 1
190	CONSOLE_DEBUG("There are now %lu registered solvers", gl_length(solver_get_list(0)));
191	#endif
192	return 0;
193	}
194
195
196	/*------------------------------------------------------------------------------
197	SOLVER REGISTRATION
198	*/
199
200	/* rewrote this stuff to get rid of all the #ifdefs -- JP */
201
202	struct StaticSolverRegistration{
203	const char *importname;
204	};
205
206	/*
207	The names here are only used to provide information in the case where
208	solver registration fails. The definitive solver names are in the slv*.c
209	files.
210	*/
211	static const struct StaticSolverRegistration slv_reg[]={
212	{"qrslv"}
213	,{"conopt"}
214	,{"lrslv"}
215	,{"cmslv"}
216	/* ,{"ipopt"} */
217	,{NULL}
218	#if 0
219	/* {0,"SLV",&slv0_register} */
220	/* ,{0,"MINOS",&slv1_register} */
221	/* ,{0,"CSLV",&slv4_register} */
222	/* ,{0,"LSSLV",&slv5_register} */
223	/* ,{0,"MPS",&slv6_register} */
224	/* ,{0,"NGSLV",&slv7_register} */
225	/* ,{0,"OPTSQP",&slv2_register} */
226	#endif
227	};
228
229	int SlvRegisterStandardClients(void){
230	int nclients = 0;
231	//int newclient=0;
232	int error;
233	int i;
234
235	/* CONSOLE_DEBUG("REGISTERING STANDARD SOLVER ENGINES"); */
236	for(i=0; slv_reg[i].importname!=NULL;++i){
237	error = package_load(slv_reg[i].importname,NULL);
238	if(error){
239	ERROR_REPORTER_HERE(ASC_PROG_ERR
240	,"Unable to register solver '%s' (error %d)."
241	,slv_reg[i].importname,error
242	);
243	}else{
244	CONSOLE_DEBUG("Solver '%s' registered OK",slv_reg[i].importname);
245	nclients++;
246	}
247	}
248	return nclients;
249	}
250
251	/------------------------------------------------------/
252
253	static void printwarning(const char * fname, slv_system_t sys)
254	{
255	ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,
256	"%s called with bad registered client (%s).",fname,
257	slv_solver_name(slv_get_selected_solver(sys)));
258	}
259
260	static void printinfo(slv_system_t sys, const char *rname){
261	asc_assert(sys->internals);
262	if(sys->internals->name) {
263	ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,
264	"Client %s does not support function '%s'.",
265	sys->internals->name,rname);
266	}
267	}
268
269	/*-----------------------------------------------------------
270	These macros do some more elimination of repetition. Here we're
271	trying to replace some more complex 'method-like' calls on
272	slv_system_t:
273
274	These macros use macro-argument-concatenation and macro stringification.
275	Verified that the former works with Visual C++.
276	http://www.codeproject.com/macro/metamacros.asp
277	*/
278
279	/** Define a method like 'void slv_METHODNAME(sys)' */
280	#define DEFINE_SLV_PROXY_METHOD_VOID(METHOD) \
281	void slv_ ## METHOD (slv_system_t sys){ \
282	if(CF(sys,METHOD)==NULL){ \
283	printwarning(#METHOD,sys); \
284	return; \
285	} \
286	SF(sys,METHOD)(sys,sys->ct); \
287	}
288
289	/** Define a method like 'RETURNTYPE slv_METHOD(sys)'; */
290	#define DEFINE_SLV_PROXY_METHOD(METHOD,PROP,RETTYPE,ERRVAL) \
291	RETTYPE slv_ ## METHOD (slv_system_t sys){ \
292	/* CONSOLE_DEBUG("slv_" #METHOD);*/ \
293	asc_assert(sys->internals); \
294	/CONSOLE_DEBUG("internals OK");/ \
295	if(sys->internals->PROP==NULL){ \
296	/CONSOLE_DEBUG("method is NULL");/ \
297	printinfo(sys, #METHOD); \
298	return ERRVAL; \
299	} \
300	/CONSOLE_DEBUG("running method " #PROP " in solver %d",sys->internals->number);/ \
301	return (sys->internals->PROP)(sys,sys->ct); \
302	}
303
304	/** Define a method like 'void slv_METHOD(sys,TYPE PARAMNAME)'; */
305	#define DEFINE_SLV_PROXY_METHOD_PARAM(METHOD,PROP,PARAMTYPE,PARAMNAME) \
306	void slv_ ## METHOD (slv_system_t sys, PARAMTYPE PARAMNAME){ \
307	if(!sys->internals \|\| !sys->internals->PROP){ \
308	printwarning(#METHOD,sys); \
309	return; \
310	} \
311	(sys->internals->PROP)(sys,sys->ct, PARAMNAME); \
312	}
313
314	DEFINE_SLV_PROXY_METHOD_PARAM(get_parameters,get_parameters,slv_parameters_t,parameters) /;*/
315
316	void slv_set_parameters(slv_system_t sys,slv_parameters_t *parameters)
317	{
318	asc_assert(sys->internals);
319	if(sys->internals->setparam == NULL ) {
320	printwarning("slv_set_parameters",sys);
321	return;
322	}
323	if (parameters->whose != sys->solver) {
324	ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,
325	"slv_set_parameters cannot pass parameters from one solver to a"
326	" another.");
327	return;
328	}
329	(sys->internals->setparam)(sys,sys->ct,parameters);
330	}
331
332	int slv_get_status(slv_system_t sys, slv_status_t *status){
333	static const SlvFunctionsT *lastsolver = 0;
334	if(!sys->internals)return -1;
335	if(sys->internals->getstatus==NULL){
336	if(lastsolver==0 \|\| lastsolver != sys->internals){
337	printinfo(sys,"get_status");
338	lastsolver = sys->internals;
339	}
340	return -1;
341	}
342	return (sys->internals->getstatus)(sys,sys->ct,status);
343	}
344
345	DEFINE_SLV_PROXY_METHOD_PARAM(dump_internals,dumpinternals,int,level) /;/
346
347	DEFINE_SLV_PROXY_METHOD(get_linsolqr_sys, getlinsys, linsolqr_system_t, NULL) /;/
348
349	DEFINE_SLV_PROXY_METHOD(get_sys_mtx, get_sys_mtx, mtx_matrix_t, NULL) /;/
350	DEFINE_SLV_PROXY_METHOD(presolve,presolve,int,-1) /;/
351	DEFINE_SLV_PROXY_METHOD(resolve,resolve,int,-1) /;/
352	DEFINE_SLV_PROXY_METHOD(iterate,iterate,int,-1) /;/
353	DEFINE_SLV_PROXY_METHOD(solve,solve,int,-1) /;/
354
355	int slv_eligible_solver(slv_system_t sys)
356	{
357	asc_assert(sys->internals);
358	if(sys->internals->celigible == NULL ) {
359	printwarning("slv_eligible_solver",sys);
360	return 0;
361	}
362	return (sys->internals->celigible)(sys);
363	}
364
365	//-------------
366
367
368	int slv_select_solver(slv_system_t sys,int solver){
369
370	int status_index;
371	SlvClientDestroyF *destroy;
372	const SlvFunctionsT *S;
373
374	if(sys ==NULL) {
375	ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver called with NULL system.");
376	return -1;
377	}
378
379	/* CONSOLE_DEBUG("CHECKING FOR SOLVER %d", solver); */
380
381	if(solver_engine(solver)){
382	/* CONSOLE_DEBUG("SOLVER FOUND"); */
383	if(sys->ct != NULL && solver != sys->solver){
384	/* CONSOLE_DEBUG("DIFFERENT SOLVER"); */
385	//CONSOLE_DEBUG("g_SlvNumberOfRegisteredClients = %d, sys->solver = %d", g_SlvNumberOfRegisteredClients, sys->solver);
386	asc_assert(sys->solver >= -1);
387	//asc_assert(g_SlvNumberOfRegisteredClients > 0);
388	//asc_assert(sys->solver < g_SlvNumberOfRegisteredClients);
389	S = solver_engine(sys->solver);
390	destroy = S->cdestroy;
391	if(destroy!=NULL) {
392	(destroy)(sys,sys->ct);
393	sys->ct = NULL;
394	}else{
395	ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver: 'cdestroy' is undefined on solver '%s' (index %d).",
396	S->name, sys->solver);
397	}
398	}
399
400	/* CONSOLE_DEBUG("PREVIOUS SOLVER IS CLEAR"); */
401
402	if(sys->ct != NULL) {
403	CONSOLE_DEBUG("CURRENT SOLVER UNCHANGED");
404	return sys->solver;
405	}
406
407	status_index = solver;
408	sys->solver = solver;
409	sys->internals = solver_engine(solver);
410	if(sys->internals->ccreate != NULL){
411	sys->ct = (sys->internals->ccreate)(sys,&status_index);
412	}else{
413	ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_select_solver create failed due to bad client '%s'.",
414	slv_solver_name(sys->solver));
415	return sys->solver;
416	}
417	if(sys->ct==NULL){
418	ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate failed in slv_select_solver.");
419	sys->solver = -1;
420	}else{
421	if (status_index){
422	ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate succeeded with warning %d %s.",
423	status_index," in slv_select_solver");
424	}
425	/* we could do a better job explaining the client warnings... */
426	sys->solver = solver;
427	}
428	}else{
429	ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver: invalid solver index '%d'.",
430	solver);
431	return -1;
432	}
433	return sys->solver;
434	}
435
436	/**
437	@TODO looks buggy
438	*/
439	int slv_switch_solver(slv_system_t sys,int solver)
440	{
441	int status_index;
442
443	if(sys ==NULL){
444	ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_switch_solver called with NULL system.");
445	return -1;
446	}
447
448	/* CONSOLE_DEBUG("CHECKING FOR SOLVER %d", solver); */
449
450	if(solver_engine(solver)){
451	status_index = solver;
452	sys->solver = solver;
453	sys->internals = solver_engine(solver);
454	CONSOLE_DEBUG("SWITCHING TO SOLVER '%s'",sys->internals->name);
455	if(sys->internals->ccreate != NULL) {
456	sys->ct = (sys->internals->ccreate)(sys,&status_index);
457	} else {
458	ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_switch_solver create failed due to bad client '%s'.",
459	slv_solver_name(sys->solver));
460	return sys->solver;
461	}
462	if (sys->ct==NULL) {
463	ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"SlvClientCreate failed in slv_switch_solver.");
464	sys->solver = -1;
465	}else{
466	if (status_index) {
467	ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate succeeded with warning %d %s.",
468	status_index," in slv_switch_solver");
469	}
470	sys->solver = solver;
471	}
472	}else{
473	ERROR_REPORTER_HERE(ASC_PROG_WARNING,"Unknown client '%d'.",solver);
474	return -1;
475	}
476	return sys->solver;
477	}
478
479	/--------------------------------/
480
481	int slv_get_selected_solver(slv_system_t sys){
482	if (sys!=NULL) return sys->solver;
483	return -1;
484	}
485
486
487	int32 slv_get_default_parameters(int sindex,
488	slv_parameters_t *parameters)
489	{
490	SlvFunctionsT *S;
491	S = solver_engine(sindex);
492	if(S){
493	if(S->getdefparam == NULL ) {
494	ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_default_parameters called with parameterless index.");
495	return 0;
496	}else{
497	/* send NULL system when setting up interface */
498	(S->getdefparam)(NULL,NULL,parameters);
499	return 1;
500	}
501	}else{
502	ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_default_parameters called with unregistered index.");
503	return 0;
504	}
505	}
506
507
508	/-----------------------------------------------------------/
509
510	SlvClientToken slv_get_client_token(slv_system_t sys)
511	{
512	if (sys==NULL) {
513	FPRINTF(stderr,"slv_get_client_token called with NULL system.");
514	return NULL;
515	}
516	return sys->ct;
517	}
518
519
520	void slv_set_client_token(slv_system_t sys, SlvClientToken ct)
521	{
522	if (sys==NULL) {
523	ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_client_token called with NULL system.");
524	return;
525	}
526	sys->ct = ct;
527	}
528
529	void slv_set_solver_index(slv_system_t sys, int solver)
530	{
531	if (sys==NULL) {
532	ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solver_index called with NULL system.");
533	return;
534	}
535	sys->solver = solver;
536	sys->internals = solver_engine(solver);
537	}
538
539
540	const char *slv_solver_name(int sindex){
541	static char errname[] = "ErrorSolver";
542	const SlvFunctionsT *S = solver_engine(sindex);
543	if(S!=NULL){
544	if(S->name == NULL) {
545	ERROR_REPORTER_HERE(ASC_PROG_WARNING,"unnamed solver: index='%d'",sindex);
546	return errname;
547	}else{
548	return S->name;
549	}
550	}else{
551	ERROR_REPORTER_HERE(ASC_PROG_ERROR,"invalid solver index '%d'", sindex);
552	return errname;
553	}
554	}
555