ascend/system/var.c

/*
 *  SLV: Ascend Numeric Solver
 *  by Karl Michael Westerberg
 *  Created: 2/6/90
 *  Version: $Revision: 1.31 $
 *  Version control file: $RCSfile: var.c,v $
 *  Date last modified: $Date: 1998/02/19 13:31:36 $
 *  Last modified by: $Author: mthomas $
 *
 *  This file is part of the SLV solver.
 *
 *  Copyright (C) 1990 Karl Michael Westerberg
 *  Copyright (C) 1993 Joseph Zaher
 *  Copyright (C) 1994 Joseph Zaher, Benjamin Andrew Allan
 *
 *  The SLV solver 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 of the
 *  License, or (at your option) any later version.
 *
 *  The SLV solver is distributed in 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 the program; if not, write to the Free Software Foundation,
 *  Inc., 675 Mass Ave, Cambridge, MA 02139 USA.  Check the file named
 *  COPYING.  COPYING is found in ../compiler.
 *
 */

#include "var.h"

#include <ascend/utilities/config.h>
#include <ascend/utilities/ascMalloc.h>
#include <ascend/utilities/ascConfig.h>
#include <ascend/general/dstring.h>
#include <ascend/general/list.h>

#include <ascend/compiler/symtab.h>
#include <ascend/compiler/instance_enum.h>

#include <ascend/compiler/module.h>
#include <ascend/compiler/library.h>

#include <ascend/compiler/child.h>
#include <ascend/compiler/type_desc.h>
#include <ascend/compiler/atomvalue.h>
#include <ascend/compiler/parentchild.h>
#include <ascend/compiler/instquery.h>
#include <ascend/compiler/instance_io.h>

#include <ascend/linear/mtx.h>

#include "slv_server.h"
#include "slv_common.h"
#include "slv_client.h"

/* useful cast */
#define IPTR(i) ((struct Instance *)(i))

/* useful symbol table things to know */
#define FIXED_V g_strings[0]
#define LOWER_V g_strings[1]
#define UPPER_V g_strings[2]
#define RELAXED_V g_strings[3]
#define NOMINAL_V g_strings[4]
#define INTERFACE_V g_strings[5]
#define ODEATOL_V g_strings[6]

/*
 * array of those symbol table entries we need.
 */
static symchar * g_strings[7];

SlvBackendToken var_instanceF(const struct var_variable *var)
{ if (var==NULL || var->ratom==NULL) {
    FPRINTF(stderr,"var_instance called on bad var\n");
    return NULL;
  }
  return var->ratom;
}

void var_set_instanceF(struct var_variable *var, SlvBackendToken i)
{
  if (var==NULL)  {
    FPRINTF(stderr,"var_set_instance called on NULL var\n");
    return;
  }
  var->ratom = i;
}


char *var_make_name(const slv_system_t sys,const  struct var_variable *var){
  return WriteInstanceNameString(IPTR(var->ratom),IPTR(slv_instance(sys)));
}

char *var_make_xname(const struct var_variable *var)
{
   static char name[81];
   char *res;
   sprintf(name,"x%d",var_sindex(var));
   res=ASC_NEW_ARRAY(char,strlen(name)+1);
   sprintf(res,"%s",name);
   return res;
}

void var_write_name(const slv_system_t sys,
  const struct var_variable *var,FILE *fp)
{
  if (var == NULL || fp==NULL) return;
  if (sys!=NULL) {
    WriteInstanceName(fp,var_instance(var),slv_instance(sys));
  } else {
    WriteInstanceName(fp,var_instance(var),NULL);
  }
}

void var_destroy(struct var_variable *var)
{
  if (var==NULL) return;
  var->ratom = NULL;
  ascfree((POINTER)var->incidence);
}


int32 var_mindexF(const struct var_variable *var)
{
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return -1;
  }
  return var->mindex;
}

void var_set_mindexF(struct var_variable *var, int32 mindex)
{
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  var->mindex = mindex;
}

int32 var_sindexF(const struct var_variable *var)
{
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return -1;
  }
  return var->sindex;
}

void var_set_sindexF(struct var_variable *var, int32 sindex)
{
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  var->sindex = sindex;
}

real64 var_value(const struct var_variable *var)
{
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return 0.0;
  }
  return( RealAtomValue(var->ratom) );
}

void var_set_value(struct var_variable *var, real64 value)
{
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  SetRealAtomValue(var->ratom,value,(unsigned)0);
}

real64 var_nominal(struct var_variable *var)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return 1.0;
  }
  c = ChildByChar(var->ratom,NOMINAL_V);
  if( c == NULL ) {
    FPRINTF(ASCERR,"no 'nominal' field in variable");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return 1.0;
  }
  return( RealAtomValue(c) );
}

void var_set_nominal(struct var_variable *var, real64 nominal)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  c = ChildByChar(IPTR(var->ratom),NOMINAL_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'nominal' field in var");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return;
  }
  SetRealAtomValue(c,nominal,(unsigned)0);
}


real64 var_lower_bound(struct var_variable *var)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return 0.0;
  }
  c = ChildByChar(IPTR(var->ratom),LOWER_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'lower_bound' field");
    WriteInstance(stderr,IPTR(var->ratom));
    return 0.0;
  }
  return( RealAtomValue(c) );
}

void var_set_lower_bound(struct var_variable *var, real64 lower_bound)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  c = ChildByChar(IPTR(var->ratom),LOWER_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'lower_bound' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return;
  }
  SetRealAtomValue(c,lower_bound,(unsigned)0);
}


real64 var_upper_bound(struct var_variable *var)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return 0.0;
  }
  c = ChildByChar(IPTR(var->ratom),UPPER_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'upper_bound' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return 0.0;
  }
  return( RealAtomValue(c) );
}

void var_set_upper_bound(struct var_variable *var, real64 upper_bound)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  c = ChildByChar(IPTR(var->ratom),UPPER_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'upper_bound' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return;
  }
  SetRealAtomValue(c,upper_bound,(unsigned)0);
}

double var_odeatol(struct var_variable *var){
    struct Instance *c;
    if(var==NULL||var->ratom==NULL){
        ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
        return -1;
    }
    c = ChildByChar(IPTR(var->ratom),ODEATOL_V);
    if(c==NULL){
        ERROR_REPORTER_HERE(ASC_PROG_ERR,"no '%s' field",SCP(ODEATOL_V));
        return -1;
    }
    return RealAtomValue(c);
}
    

uint32 var_flagsF(const struct var_variable *var)
{
  return var->flags;
}

void var_set_flagsF(struct var_variable *var, uint32 flags)
{
  var->flags = flags;
}

uint32 var_fixed(struct var_variable *var)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return FALSE;
  }
  c = ChildByChar(IPTR(var->ratom),FIXED_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'fixed' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return FALSE;
  }
  var_set_flagbit(var,VAR_FIXED,GetBooleanAtomValue(c));
  return( GetBooleanAtomValue(c) );
}

void var_set_fixed(struct var_variable *var, uint32 fixed)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  c = ChildByChar(IPTR(var->ratom),FIXED_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'fixed' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return;
  }
  SetBooleanAtomValue(c,fixed,(unsigned)0);
  var_set_flagbit(var,VAR_FIXED,fixed);
}

uint32 var_relaxed(struct var_variable *var)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return FALSE;
  }
  c = ChildByChar((var->ratom),RELAXED_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'relaxed' field");
    /* WriteInstance(stderr,(var->ratom)); */
    return FALSE;
  }
  var_set_flagbit(var,VAR_RELAXED,GetBooleanAtomValue(c));
  return( GetBooleanAtomValue(c) );
}

void var_set_relaxed(struct var_variable *var, uint32 fixed)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  c = ChildByChar(IPTR(var->ratom),RELAXED_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'relaxed' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return;
  }
  SetBooleanAtomValue(c,fixed,(unsigned)0);
  var_set_flagbit(var,VAR_RELAXED,fixed);
}

uint32 var_interface(struct var_variable *var)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return FALSE;
  }
  c = ChildByChar(IPTR(var->ratom),INTERFACE_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'interface' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return 0;
  }
  var_set_flagbit(var,VAR_INTERFACE,GetBooleanAtomValue(c));
  return( GetIntegerAtomValue(c) );
}

extern uint32 var_flagbit(const struct var_variable *var,const uint32 one)
{
  if (var==NULL || var->ratom == NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return 0;
  }
  return (var->flags & one);
}

void var_set_flagbit(struct var_variable *var, uint32 field,uint32 one)
{
  if (var==NULL || var->ratom == NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  if (one) {
    var->flags |= field;
  } else {
    var->flags &= ~field;
  }
}

int32 var_apply_filter(const struct var_variable *var, 
    const var_filter_t *filter
){
  if (var==NULL || filter==NULL || var->ratom == NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"miscalled with NULL");
    return FALSE;
  }
  /* AND to mask off irrelevant bits in flags and match value, then compare */
  return (filter->matchbits & var->flags) == (filter->matchbits & filter->matchvalue);
}

/**
    Implementation function for var_n_incidences().  Do not call this
    function directly - use var_n_incidences() instead.
*/
int32 var_n_incidencesF(struct var_variable *var)
{
  if (var!=NULL) return var->n_incidences;
  ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL var");
  return 0;
}

void var_set_incidencesF(struct var_variable *var,int32 n,
                         struct rel_relation **i)
{
  if(var!=NULL && n >=0) {
    if (n && i==NULL) {
      ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL i");
    }
    var->n_incidences = n;
    var->incidence = i;
    return;
  }
  ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL var, or n < 0");
}
const struct rel_relation **var_incidence_list( struct var_variable *var)
{
  if (var==NULL) return NULL;
  return( (const struct rel_relation **)var->incidence );
}

struct rel_relation **var_incidence_list_to_modify( struct var_variable *var)
{
  if (var==NULL) return NULL;
  return( (struct rel_relation **)var->incidence );
}


/* 
 * global for use with the push function. Sets the ip to the
 * value in g_var_tag;
 * should be using vp instead of a global counter.
 */
static void *g_var_tag = NULL;
static void * SetVarTags(struct Instance *i,VOIDPTR vp)
{
  (void)vp;
  if (i!=NULL && InstanceKind(i)==REAL_ATOM_INST) {
    return g_var_tag;
  } else {
    return NULL;
  }
}

struct var_variable **var_BackendTokens_to_vars(slv_system_t sys,
  SlvBackendToken *atoms, int32 len)
{
  int32 vartot,vlen,count=0;
  UGLint apos,ulen;
  GLint i;
  struct var_variable **result;
  struct var_variable **vlist;
  struct gl_list_t *oldips;
  if (sys==NULL || atoms == NULL || len < 1) {
    return NULL;
  }
  ulen = (UGLint)len;
  result = (struct var_variable **)malloc(len*sizeof(struct var_variable *));
  if (result == NULL) return result;
  /* init results to null */
  for (i=0; i<len; i++) result[i] = NULL;
  /* fill ips w/len in all the vars in tree. */
  g_var_tag = (void *)ulen;
  vartot = slv_get_num_master_vars(sys) +
           slv_get_num_master_pars(sys) +
           slv_get_num_master_unattached(sys);
  oldips = PushInterfacePtrs(slv_instance(sys),SetVarTags,vartot,0,NULL);
  /* fill ips of wanted atoms with i */
  for (i=0; i<len; i++) {
    if (GetInterfacePtr(atoms[i])==g_var_tag &&
    InstanceKind(atoms[i]) == REAL_ATOM_INST) {
    /* guard a little */
      SetInterfacePtr((struct Instance *)atoms[i],(void *)i);
    } else {
      /* the odds of g_var_tag being a legal pointer are vanishingly
    small, so if we find an ATOM without g_var_tag we assume it
    is outside the tree and shouldn't have been in the list. */
      ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad token");
    }
  }
  /* run through the master lists and put the vars with their atoms */
  vlist = slv_get_master_var_list(sys);
  vlen = slv_get_num_master_vars(sys);
  for (i = 0; i <vlen; i++) {
    apos = (UGLint)GetInterfacePtr(var_instance(vlist[i]));
    if ( apos < ulen ) {
      result[apos] = vlist[i];
      count++;
    }
  }
  vlist = slv_get_master_par_list(sys);
  vlen = slv_get_num_master_pars(sys);
  for (i = 0; i <vlen; i++) {
    apos = (UGLint)GetInterfacePtr(var_instance(vlist[i]));
    if ( apos < ulen ) {
      result[apos] = vlist[i];
      count++;
    }
  }
  vlist = slv_get_master_unattached_list(sys);
  vlen = slv_get_num_master_unattached(sys);
  for (i = 0; i <vlen; i++) {
    apos = (UGLint)GetInterfacePtr(var_instance(vlist[i]));
    if ( apos < ulen ) {
      result[apos] = vlist[i];
      count++;
    }
  }
  if (count < len) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"found less than expected vars (len = %d, found = %d)",len,count);
  } else {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"found more than expected vars (len = %d, found = %d)",len,count);
  }
  PopInterfacePtrs(oldips,NULL,NULL);
  return result;
}

static struct TypeDescription *g_solver_var_type;
static struct TypeDescription *g_solver_int_type;
static struct TypeDescription *g_solver_binary_type;
static struct TypeDescription *g_solver_semi_type;

boolean set_solver_types(void) {
  boolean nerr = 0;
  if( (g_solver_var_type = FindType(AddSymbol(SOLVER_VAR_STR))) == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_var' not defined");
    nerr++;
  }
  if( (g_solver_int_type = FindType(AddSymbol(SOLVER_INT_STR))) == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERROR,"'solver_int' not defined: MPS will not work");
    nerr++;
  }
  g_solver_binary_type = FindType(AddSymbol(SOLVER_BINARY_STR));
  if( g_solver_binary_type == NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_binary' not defined: MPS will not work");
    nerr++;
  }
  if( (g_solver_semi_type = FindType(AddSymbol(SOLVER_SEMI_STR))) == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_semi' not defined: MPS will not work");
    nerr++;
  }

  LOWER_V = AddSymbol("lower_bound");
  UPPER_V = AddSymbol("upper_bound");
  RELAXED_V = AddSymbol("relaxed");
  NOMINAL_V = AddSymbol("nominal");
  FIXED_V = AddSymbol("fixed");
  INTERFACE_V = AddSymbol("interface");
  ODEATOL_V = AddSymbol("ode_atol"); 
  return nerr;
}

boolean solver_var( SlvBackendToken inst)
{
  struct TypeDescription *type;

  if (!g_solver_var_type) return FALSE;
  type = InstanceTypeDesc(IPTR(inst));
  return( type == MoreRefined(type,g_solver_var_type) );
}

boolean solver_int( SlvBackendToken inst)
{
  struct TypeDescription *type;

  if (!g_solver_int_type) return FALSE;
  type = InstanceTypeDesc(IPTR(inst));
  return( type == MoreRefined(type,g_solver_int_type) );
}

boolean solver_binary( SlvBackendToken inst)
{
  struct TypeDescription *type;

  if (!g_solver_binary_type) return FALSE;
  type = InstanceTypeDesc(IPTR(inst));
  return( type == MoreRefined(type,g_solver_binary_type) );
}

boolean solver_semi( SlvBackendToken inst)
{
  struct TypeDescription *type;

  if (!g_solver_semi_type) return FALSE;
  type = InstanceTypeDesc(IPTR(inst));
  return( type == MoreRefined(type,g_solver_semi_type) );
}

1	/*
2	* SLV: Ascend Numeric Solver
3	* by Karl Michael Westerberg
4	* Created: 2/6/90
5	* Version: $Revision: 1.31 $
6	* Version control file: $RCSfile: var.c,v $
7	* Date last modified: $Date: 1998/02/19 13:31:36 $
8	* Last modified by: $Author: mthomas $
9	*
10	* This file is part of the SLV solver.
11	*
12	* Copyright (C) 1990 Karl Michael Westerberg
13	* Copyright (C) 1993 Joseph Zaher
14	* Copyright (C) 1994 Joseph Zaher, Benjamin Andrew Allan
15	*
16	* The SLV solver is free software; you can redistribute
17	* it and/or modify it under the terms of the GNU General Public License as
18	* published by the Free Software Foundation; either version 2 of the
19	* License, or (at your option) any later version.
20	*
21	* The SLV solver is distributed in hope that it will be
22	* useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
23	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
24	* General Public License for more details.
25	*
26	* You should have received a copy of the GNU General Public License
27	* along with the program; if not, write to the Free Software Foundation,
28	* Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
29	* COPYING. COPYING is found in ../compiler.
30	*
31	*/
32
33	#include "var.h"
34
35	#include <ascend/utilities/config.h>
36	#include <ascend/utilities/ascMalloc.h>
37	#include <ascend/utilities/ascConfig.h>
38	#include <ascend/general/dstring.h>
39	#include <ascend/general/list.h>
40
41	#include <ascend/compiler/symtab.h>
42	#include <ascend/compiler/instance_enum.h>
43
44	#include <ascend/compiler/module.h>
45	#include <ascend/compiler/library.h>
46
47	#include <ascend/compiler/child.h>
48	#include <ascend/compiler/type_desc.h>
49	#include <ascend/compiler/atomvalue.h>
50	#include <ascend/compiler/parentchild.h>
51	#include <ascend/compiler/instquery.h>
52	#include <ascend/compiler/instance_io.h>
53
54	#include <ascend/linear/mtx.h>
55
56	#include "slv_server.h"
57	#include "slv_common.h"
58	#include "slv_client.h"
59
60	/* useful cast */
61	#define IPTR(i) ((struct Instance *)(i))
62
63	/* useful symbol table things to know */
64	#define FIXED_V g_strings[0]
65	#define LOWER_V g_strings[1]
66	#define UPPER_V g_strings[2]
67	#define RELAXED_V g_strings[3]
68	#define NOMINAL_V g_strings[4]
69	#define INTERFACE_V g_strings[5]
70	#define ODEATOL_V g_strings[6]
71
72	/*
73	* array of those symbol table entries we need.
74	*/
75	static symchar * g_strings[7];
76
77	SlvBackendToken var_instanceF(const struct var_variable *var)
78	{ if (var==NULL \|\| var->ratom==NULL) {
79	FPRINTF(stderr,"var_instance called on bad var\n");
80	return NULL;
81	}
82	return var->ratom;
83	}
84
85	void var_set_instanceF(struct var_variable *var, SlvBackendToken i)
86	{
87	if (var==NULL) {
88	FPRINTF(stderr,"var_set_instance called on NULL var\n");
89	return;
90	}
91	var->ratom = i;
92	}
93
94
95	char var_make_name(const slv_system_t sys,const struct var_variable var){
96	return WriteInstanceNameString(IPTR(var->ratom),IPTR(slv_instance(sys)));
97	}
98
99	char var_make_xname(const struct var_variable var)
100	{
101	static char name[81];
102	char *res;
103	sprintf(name,"x%d",var_sindex(var));
104	res=ASC_NEW_ARRAY(char,strlen(name)+1);
105	sprintf(res,"%s",name);
106	return res;
107	}
108
109	void var_write_name(const slv_system_t sys,
110	const struct var_variable var,FILE fp)
111	{
112	if (var == NULL \|\| fp==NULL) return;
113	if (sys!=NULL) {
114	WriteInstanceName(fp,var_instance(var),slv_instance(sys));
115	} else {
116	WriteInstanceName(fp,var_instance(var),NULL);
117	}
118	}
119
120	void var_destroy(struct var_variable *var)
121	{
122	if (var==NULL) return;
123	var->ratom = NULL;
124	ascfree((POINTER)var->incidence);
125	}
126
127
128	int32 var_mindexF(const struct var_variable *var)
129	{
130	if (var==NULL \|\| var->ratom==NULL) {
131	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
132	return -1;
133	}
134	return var->mindex;
135	}
136
137	void var_set_mindexF(struct var_variable *var, int32 mindex)
138	{
139	if (var==NULL \|\| var->ratom==NULL) {
140	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
141	return;
142	}
143	var->mindex = mindex;
144	}
145
146	int32 var_sindexF(const struct var_variable *var)
147	{
148	if (var==NULL \|\| var->ratom==NULL) {
149	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
150	return -1;
151	}
152	return var->sindex;
153	}
154
155	void var_set_sindexF(struct var_variable *var, int32 sindex)
156	{
157	if (var==NULL \|\| var->ratom==NULL) {
158	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
159	return;
160	}
161	var->sindex = sindex;
162	}
163
164	real64 var_value(const struct var_variable *var)
165	{
166	if (var==NULL \|\| var->ratom==NULL) {
167	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
168	return 0.0;
169	}
170	return( RealAtomValue(var->ratom) );
171	}
172
173	void var_set_value(struct var_variable *var, real64 value)
174	{
175	if (var==NULL \|\| var->ratom==NULL) {
176	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
177	return;
178	}
179	SetRealAtomValue(var->ratom,value,(unsigned)0);
180	}
181
182	real64 var_nominal(struct var_variable *var)
183	{
184	struct Instance *c;
185	if (var==NULL \|\| var->ratom==NULL) {
186	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
187	return 1.0;
188	}
189	c = ChildByChar(var->ratom,NOMINAL_V);
190	if( c == NULL ) {
191	FPRINTF(ASCERR,"no 'nominal' field in variable");
192	/* WriteInstance(stderr,IPTR(var->ratom)); */
193	return 1.0;
194	}
195	return( RealAtomValue(c) );
196	}
197
198	void var_set_nominal(struct var_variable *var, real64 nominal)
199	{
200	struct Instance *c;
201	if (var==NULL \|\| var->ratom==NULL) {
202	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
203	return;
204	}
205	c = ChildByChar(IPTR(var->ratom),NOMINAL_V);
206	if( c == NULL ) {
207	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'nominal' field in var");
208	/* WriteInstance(stderr,IPTR(var->ratom)); */
209	return;
210	}
211	SetRealAtomValue(c,nominal,(unsigned)0);
212	}
213
214
215	real64 var_lower_bound(struct var_variable *var)
216	{
217	struct Instance *c;
218	if (var==NULL \|\| var->ratom==NULL) {
219	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
220	return 0.0;
221	}
222	c = ChildByChar(IPTR(var->ratom),LOWER_V);
223	if( c == NULL ) {
224	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'lower_bound' field");
225	WriteInstance(stderr,IPTR(var->ratom));
226	return 0.0;
227	}
228	return( RealAtomValue(c) );
229	}
230
231	void var_set_lower_bound(struct var_variable *var, real64 lower_bound)
232	{
233	struct Instance *c;
234	if (var==NULL \|\| var->ratom==NULL) {
235	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
236	return;
237	}
238	c = ChildByChar(IPTR(var->ratom),LOWER_V);
239	if( c == NULL ) {
240	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'lower_bound' field");
241	/* WriteInstance(stderr,IPTR(var->ratom)); */
242	return;
243	}
244	SetRealAtomValue(c,lower_bound,(unsigned)0);
245	}
246
247
248	real64 var_upper_bound(struct var_variable *var)
249	{
250	struct Instance *c;
251	if (var==NULL \|\| var->ratom==NULL) {
252	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
253	return 0.0;
254	}
255	c = ChildByChar(IPTR(var->ratom),UPPER_V);
256	if( c == NULL ) {
257	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'upper_bound' field");
258	/* WriteInstance(stderr,IPTR(var->ratom)); */
259	return 0.0;
260	}
261	return( RealAtomValue(c) );
262	}
263
264	void var_set_upper_bound(struct var_variable *var, real64 upper_bound)
265	{
266	struct Instance *c;
267	if (var==NULL \|\| var->ratom==NULL) {
268	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
269	return;
270	}
271	c = ChildByChar(IPTR(var->ratom),UPPER_V);
272	if( c == NULL ) {
273	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'upper_bound' field");
274	/* WriteInstance(stderr,IPTR(var->ratom)); */
275	return;
276	}
277	SetRealAtomValue(c,upper_bound,(unsigned)0);
278	}
279
280	double var_odeatol(struct var_variable *var){
281	struct Instance *c;
282	if(var==NULL\|\|var->ratom==NULL){
283	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
284	return -1;
285	}
286	c = ChildByChar(IPTR(var->ratom),ODEATOL_V);
287	if(c==NULL){
288	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no '%s' field",SCP(ODEATOL_V));
289	return -1;
290	}
291	return RealAtomValue(c);
292	}
293
294
295	uint32 var_flagsF(const struct var_variable *var)
296	{
297	return var->flags;
298	}
299
300	void var_set_flagsF(struct var_variable *var, uint32 flags)
301	{
302	var->flags = flags;
303	}
304
305	uint32 var_fixed(struct var_variable *var)
306	{
307	struct Instance *c;
308	if (var==NULL \|\| var->ratom==NULL) {
309	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
310	return FALSE;
311	}
312	c = ChildByChar(IPTR(var->ratom),FIXED_V);
313	if( c == NULL ) {
314	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'fixed' field");
315	/* WriteInstance(stderr,IPTR(var->ratom)); */
316	return FALSE;
317	}
318	var_set_flagbit(var,VAR_FIXED,GetBooleanAtomValue(c));
319	return( GetBooleanAtomValue(c) );
320	}
321
322	void var_set_fixed(struct var_variable *var, uint32 fixed)
323	{
324	struct Instance *c;
325	if (var==NULL \|\| var->ratom==NULL) {
326	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
327	return;
328	}
329	c = ChildByChar(IPTR(var->ratom),FIXED_V);
330	if( c == NULL ) {
331	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'fixed' field");
332	/* WriteInstance(stderr,IPTR(var->ratom)); */
333	return;
334	}
335	SetBooleanAtomValue(c,fixed,(unsigned)0);
336	var_set_flagbit(var,VAR_FIXED,fixed);
337	}
338
339	uint32 var_relaxed(struct var_variable *var)
340	{
341	struct Instance *c;
342	if (var==NULL \|\| var->ratom==NULL) {
343	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
344	return FALSE;
345	}
346	c = ChildByChar((var->ratom),RELAXED_V);
347	if( c == NULL ) {
348	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'relaxed' field");
349	/* WriteInstance(stderr,(var->ratom)); */
350	return FALSE;
351	}
352	var_set_flagbit(var,VAR_RELAXED,GetBooleanAtomValue(c));
353	return( GetBooleanAtomValue(c) );
354	}
355
356	void var_set_relaxed(struct var_variable *var, uint32 fixed)
357	{
358	struct Instance *c;
359	if (var==NULL \|\| var->ratom==NULL) {
360	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
361	return;
362	}
363	c = ChildByChar(IPTR(var->ratom),RELAXED_V);
364	if( c == NULL ) {
365	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'relaxed' field");
366	/* WriteInstance(stderr,IPTR(var->ratom)); */
367	return;
368	}
369	SetBooleanAtomValue(c,fixed,(unsigned)0);
370	var_set_flagbit(var,VAR_RELAXED,fixed);
371	}
372
373	uint32 var_interface(struct var_variable *var)
374	{
375	struct Instance *c;
376	if (var==NULL \|\| var->ratom==NULL) {
377	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
378	return FALSE;
379	}
380	c = ChildByChar(IPTR(var->ratom),INTERFACE_V);
381	if( c == NULL ) {
382	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'interface' field");
383	/* WriteInstance(stderr,IPTR(var->ratom)); */
384	return 0;
385	}
386	var_set_flagbit(var,VAR_INTERFACE,GetBooleanAtomValue(c));
387	return( GetIntegerAtomValue(c) );
388	}
389
390	extern uint32 var_flagbit(const struct var_variable *var,const uint32 one)
391	{
392	if (var==NULL \|\| var->ratom == NULL) {
393	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
394	return 0;
395	}
396	return (var->flags & one);
397	}
398
399	void var_set_flagbit(struct var_variable *var, uint32 field,uint32 one)
400	{
401	if (var==NULL \|\| var->ratom == NULL) {
402	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
403	return;
404	}
405	if (one) {
406	var->flags \|= field;
407	} else {
408	var->flags &= ~field;
409	}
410	}
411
412	int32 var_apply_filter(const struct var_variable *var,
413	const var_filter_t *filter
414	){
415	if (var==NULL \|\| filter==NULL \|\| var->ratom == NULL) {
416	ERROR_REPORTER_HERE(ASC_PROG_ERR,"miscalled with NULL");
417	return FALSE;
418	}
419	/* AND to mask off irrelevant bits in flags and match value, then compare */
420	return (filter->matchbits & var->flags) == (filter->matchbits & filter->matchvalue);
421	}
422
423	/**
424	Implementation function for var_n_incidences(). Do not call this
425	function directly - use var_n_incidences() instead.
426	*/
427	int32 var_n_incidencesF(struct var_variable *var)
428	{
429	if (var!=NULL) return var->n_incidences;
430	ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL var");
431	return 0;
432	}
433
434	void var_set_incidencesF(struct var_variable *var,int32 n,
435	struct rel_relation **i)
436	{
437	if(var!=NULL && n >=0) {
438	if (n && i==NULL) {
439	ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL i");
440	}
441	var->n_incidences = n;
442	var->incidence = i;
443	return;
444	}
445	ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL var, or n < 0");
446	}
447	const struct rel_relation *var_incidence_list( struct var_variable var)
448	{
449	if (var==NULL) return NULL;
450	return( (const struct rel_relation **)var->incidence );
451	}
452
453	struct rel_relation *var_incidence_list_to_modify( struct var_variable var)
454	{
455	if (var==NULL) return NULL;
456	return( (struct rel_relation **)var->incidence );
457	}
458
459
460
461	/*
462	* global for use with the push function. Sets the ip to the
463	* value in g_var_tag;
464	* should be using vp instead of a global counter.
465	*/
466	static void *g_var_tag = NULL;
467	static void * SetVarTags(struct Instance *i,VOIDPTR vp)
468	{
469	(void)vp;
470	if (i!=NULL && InstanceKind(i)==REAL_ATOM_INST) {
471	return g_var_tag;
472	} else {
473	return NULL;
474	}
475	}
476
477	struct var_variable **var_BackendTokens_to_vars(slv_system_t sys,
478	SlvBackendToken *atoms, int32 len)
479	{
480	int32 vartot,vlen,count=0;
481	UGLint apos,ulen;
482	GLint i;
483	struct var_variable **result;
484	struct var_variable **vlist;
485	struct gl_list_t *oldips;
486	if (sys==NULL \|\| atoms == NULL \|\| len < 1) {
487	return NULL;
488	}
489	ulen = (UGLint)len;
490	result = (struct var_variable *)malloc(lensizeof(struct var_variable *));
491	if (result == NULL) return result;
492	/* init results to null */
493	for (i=0; i<len; i++) result[i] = NULL;
494	/* fill ips w/len in all the vars in tree. */
495	g_var_tag = (void *)ulen;
496	vartot = slv_get_num_master_vars(sys) +
497	slv_get_num_master_pars(sys) +
498	slv_get_num_master_unattached(sys);
499	oldips = PushInterfacePtrs(slv_instance(sys),SetVarTags,vartot,0,NULL);
500	/* fill ips of wanted atoms with i */
501	for (i=0; i<len; i++) {
502	if (GetInterfacePtr(atoms[i])==g_var_tag &&
503	InstanceKind(atoms[i]) == REAL_ATOM_INST) {
504	/* guard a little */
505	SetInterfacePtr((struct Instance )atoms[i],(void )i);
506	} else {
507	/* the odds of g_var_tag being a legal pointer are vanishingly
508	small, so if we find an ATOM without g_var_tag we assume it
509	is outside the tree and shouldn't have been in the list. */
510	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad token");
511	}
512	}
513	/* run through the master lists and put the vars with their atoms */
514	vlist = slv_get_master_var_list(sys);
515	vlen = slv_get_num_master_vars(sys);
516	for (i = 0; i <vlen; i++) {
517	apos = (UGLint)GetInterfacePtr(var_instance(vlist[i]));
518	if ( apos < ulen ) {
519	result[apos] = vlist[i];
520	count++;
521	}
522	}
523	vlist = slv_get_master_par_list(sys);
524	vlen = slv_get_num_master_pars(sys);
525	for (i = 0; i <vlen; i++) {
526	apos = (UGLint)GetInterfacePtr(var_instance(vlist[i]));
527	if ( apos < ulen ) {
528	result[apos] = vlist[i];
529	count++;
530	}
531	}
532	vlist = slv_get_master_unattached_list(sys);
533	vlen = slv_get_num_master_unattached(sys);
534	for (i = 0; i <vlen; i++) {
535	apos = (UGLint)GetInterfacePtr(var_instance(vlist[i]));
536	if ( apos < ulen ) {
537	result[apos] = vlist[i];
538	count++;
539	}
540	}
541	if (count < len) {
542	ERROR_REPORTER_HERE(ASC_PROG_ERR,"found less than expected vars (len = %d, found = %d)",len,count);
543	} else {
544	ERROR_REPORTER_HERE(ASC_PROG_ERR,"found more than expected vars (len = %d, found = %d)",len,count);
545	}
546	PopInterfacePtrs(oldips,NULL,NULL);
547	return result;
548	}
549
550	static struct TypeDescription *g_solver_var_type;
551	static struct TypeDescription *g_solver_int_type;
552	static struct TypeDescription *g_solver_binary_type;
553	static struct TypeDescription *g_solver_semi_type;
554
555	boolean set_solver_types(void) {
556	boolean nerr = 0;
557	if( (g_solver_var_type = FindType(AddSymbol(SOLVER_VAR_STR))) == NULL ) {
558	ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_var' not defined");
559	nerr++;
560	}
561	if( (g_solver_int_type = FindType(AddSymbol(SOLVER_INT_STR))) == NULL ) {
562	ERROR_REPORTER_HERE(ASC_PROG_ERROR,"'solver_int' not defined: MPS will not work");
563	nerr++;
564	}
565	g_solver_binary_type = FindType(AddSymbol(SOLVER_BINARY_STR));
566	if( g_solver_binary_type == NULL) {
567	ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_binary' not defined: MPS will not work");
568	nerr++;
569	}
570	if( (g_solver_semi_type = FindType(AddSymbol(SOLVER_SEMI_STR))) == NULL ) {
571	ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_semi' not defined: MPS will not work");
572	nerr++;
573	}
574
575	LOWER_V = AddSymbol("lower_bound");
576	UPPER_V = AddSymbol("upper_bound");
577	RELAXED_V = AddSymbol("relaxed");
578	NOMINAL_V = AddSymbol("nominal");
579	FIXED_V = AddSymbol("fixed");
580	INTERFACE_V = AddSymbol("interface");
581	ODEATOL_V = AddSymbol("ode_atol");
582	return nerr;
583	}
584
585	boolean solver_var( SlvBackendToken inst)
586	{
587	struct TypeDescription *type;
588
589	if (!g_solver_var_type) return FALSE;
590	type = InstanceTypeDesc(IPTR(inst));
591	return( type == MoreRefined(type,g_solver_var_type) );
592	}
593
594	boolean solver_int( SlvBackendToken inst)
595	{
596	struct TypeDescription *type;
597
598	if (!g_solver_int_type) return FALSE;
599	type = InstanceTypeDesc(IPTR(inst));
600	return( type == MoreRefined(type,g_solver_int_type) );
601	}
602
603	boolean solver_binary( SlvBackendToken inst)
604	{
605	struct TypeDescription *type;
606
607	if (!g_solver_binary_type) return FALSE;
608	type = InstanceTypeDesc(IPTR(inst));
609	return( type == MoreRefined(type,g_solver_binary_type) );
610	}
611
612	boolean solver_semi( SlvBackendToken inst)
613	{
614	struct TypeDescription *type;
615
616	if (!g_solver_semi_type) return FALSE;
617	type = InstanceTypeDesc(IPTR(inst));
618	return( type == MoreRefined(type,g_solver_semi_type) );
619	}
620