int
IFeval(IFparseTree * tree, double gmin, double *result, double *vals,
double *derivs)
{
int i, err;
INPparseTree *myTree = (INPparseTree *) tree;
#ifdef TRACE
INPptPrint("calling PTeval, tree = ", tree);
printf("values:");
for (i = 0; i < myTree->p.numVars; i++)
printf("\tvar%d = %lg\n", i, vals[i]);
#endif
if ((err = PTeval(myTree->tree, gmin, result, vals)) != OK) {
if (ft_ngdebug) {
INPptPrint("calling PTeval, tree = ", tree);
printf("values:");
for (i = 0; i < myTree->p.numVars; i++)
printf("\tvar%d = %lg\n", i, vals[i]);
}
if (ft_stricterror)
controlled_exit(EXIT_BAD);
else
return (err);
}
for (i = 0; i < myTree->p.numVars; i++)
if ((err = PTeval(myTree->derivs[i], gmin, &derivs[i], vals)) != OK) {
if (ft_ngdebug) {
INPptPrint("calling PTeval, tree = ", tree);
printf("results: function = %lg\n", *result);
for (i = 0; i < myTree->p.numVars; i++)
printf("\td / d var%d = %lg\n", i, derivs[i]);
}
if (ft_stricterror)
controlled_exit(EXIT_BAD);
else
return (err);
}
#ifdef TRACE
printf("results: function = %lg\n", *result);
for (i = 0; i < myTree->p.numVars; i++)
printf("\td / d var%d = %lg\n", i, derivs[i]);
#endif
return (OK);
}
static int
Gaussian_Elimination2(int dims)
{
int i, j, k, dim;
double f;
double max;
int imax;
dim = dims;
for (i = 0; i < dim; i++) {
imax = i;
max = ABS(AA[i][i]);
for (j = i+1; j < dim; j++)
if (ABS(AA[j][i]) > max) {
imax = j;
max = ABS(AA[j][i]);
}
if (max < epsi2) {
fprintf(stderr, " can not choose a pivot \n");
controlled_exit(EXIT_FAILURE);
}
if (imax != i)
for (k = i; k <= dim; k++) {
f = AA[i][k];
AA[i][k] = AA[imax][k];
AA[imax][k] = f;
}
f = 1.0 / AA[i][i];
AA[i][i] = 1.0;
for (j = i+1; j <= dim; j++)
AA[i][j] *= f;
for (j = 0; j < dim ; j++) {
if (i == j)
continue;
f = AA[j][i];
AA[j][i] = 0.0;
for (k = i+1; k <= dim; k++)
AA[j][k] -= f * AA[i][k];
}
}
return(1);
}
struct plot *
raw_read(char *name) {
char *title = "default title";
char *date = NULL;
struct plot *plots = NULL, *curpl = NULL;
char buf[BSIZE_SP], *s, *t, *r;
int flags = 0, nvars = 0, npoints = 0, i, j;
int ndimpoints, numdims = 0, dims[MAXDIMS];
bool raw_padded = TRUE, is_ascii = FALSE;
double junk;
struct dvec *v, *nv;
struct variable *vv;
wordlist *wl, *nwl;
FILE *fp, *lastin, *lastout, *lasterr;
if ((fp = fopen(name, "rb")) == NULL) {
perror(name);
controlled_exit(EXIT_FAILURE);
}
/* Since we call cp_evloop() from here, we have to do this junk. */
lastin = cp_curin;
lastout = cp_curout;
lasterr = cp_curerr;
cp_curin = cp_in;
cp_curout = cp_out;
cp_curerr = cp_err;
cp_pushcontrol();
while (fgets(buf, BSIZE_SP, fp)) {
r = strchr(buf, '\n');
if (r && r > buf && r[-1] == '\r') {
r[-1] = '\n';
r[0] = '\0';
}
/* Figure out what this line is... */
if (ciprefix("title:", buf)) {
s = buf;
SKIP(s);
NONL(s);
title = copy(s);
} else if (ciprefix("date:", buf)) {
s = buf;
SKIP(s);
NONL(s);
date = copy(s);
} else if (ciprefix("plotname:", buf)) {
s = buf;
SKIP(s);
NONL(s);
if (curpl) { /* reverse commands list */
for (wl = curpl->pl_commands, curpl->pl_commands = NULL;
wl && wl->wl_next;
wl = nwl)
{
nwl = wl->wl_next;
wl->wl_next = curpl->pl_commands;
curpl->pl_commands = wl;
}
}
curpl = alloc(struct plot);
curpl->pl_next = plots;
plots = curpl;
curpl->pl_name = copy(s);
if (!date)
date = copy(datestring());
curpl->pl_date = date;
curpl->pl_title = copy(title);
flags = VF_PERMANENT;
nvars = npoints = 0;
} else if (ciprefix("flags:", buf)) {
/*CDHW This needs leak checking carefully CDHW*/
struct variable *
cp_setparse(wordlist *wl)
{
char *name = NULL, *val, *copyval, *s, *ss;
double *td;
struct variable *listv = NULL, *vv, *lv = NULL;
struct variable *vars = NULL;
int balance;
while (wl) {
if (name)
tfree(name);
name = cp_unquote(wl->wl_word);
wl = wl->wl_next;
if ((!wl || (*wl->wl_word != '=')) && !strchr(name, '=')) {
vars = var_alloc_bool(copy(name), TRUE, vars);
tfree(name); /*DG: cp_unquote Memory leak*/
continue;
}
if (wl && eq(wl->wl_word, "=")) {
wl = wl->wl_next;
if (wl == NULL) {
fprintf(cp_err, "Error: bad set form.\n");
tfree(name); /*DG: cp_unquote Memory leak*/
if (ft_stricterror)
controlled_exit(EXIT_BAD);
return (NULL);
}
val = wl->wl_word;
wl = wl->wl_next;
} else if (wl && (*wl->wl_word == '=')) {
val = wl->wl_word + 1;
wl = wl->wl_next;
} else if ((s = strchr(name, '=')) != NULL) {
val = s + 1;
*s = '\0';
if (*val == '\0') {
if (!wl) {
fprintf(cp_err, "Error: %s equals what?.\n", name);
tfree(name); /*DG: cp_unquote Memory leak: free name before exiting*/
if (ft_stricterror)
controlled_exit(EXIT_BAD);
return (NULL);
} else {
val = wl->wl_word;
wl = wl->wl_next;
}
}
} else {
fprintf(cp_err, "Error: bad set form.\n");
tfree(name); /*DG: cp_unquote Memory leak: free name befor exiting */
if (ft_stricterror)
controlled_exit(EXIT_BAD);
return (NULL);
}
/* val = cp_unquote(val); DG: bad old val is lost*/
copyval = cp_unquote(val); /*DG*/
strcpy(val, copyval);
tfree(copyval);
if (eq(val, "(")) {
/* The beginning of a list... We have to walk down the
* list until we find a close paren... If there are nested
* ()'s, treat them as tokens... */
balance = 1;
while (wl && wl->wl_word) {
if (eq(wl->wl_word, "(")) {
balance++;
} else if (eq(wl->wl_word, ")")) {
if (!--balance)
break;
}
copyval = ss = cp_unquote(wl->wl_word);
td = ft_numparse(&ss, FALSE);
if (td)
vv = var_alloc_real(NULL, *td, NULL);
else
vv = var_alloc_string(NULL, copy(ss), NULL);
tfree(copyval); /*DG: must free ss any way to avoid cp_unquote memory leak*/
if (listv) {
lv->va_next = vv;
lv = vv;
} else {
listv = lv = vv;
}
wl = wl->wl_next;
}
if (balance && !wl) {
fprintf(cp_err, "Error: bad set form.\n");
tfree(name); /* va: cp_unquote memory leak: free name before exiting */
if (ft_stricterror)
controlled_exit(EXIT_BAD);
return (NULL);
}
vars = var_alloc_vlist(copy(name), listv, vars);
wl = wl->wl_next;
continue;
}
copyval = ss = cp_unquote(val);
td = ft_numparse(&ss, FALSE);
if (td) {
/*** We should try to get CP_NUM's... */
vars = var_alloc_real(copy(name), *td, vars);
} else {
vars = var_alloc_string(copy(name), copy(val), vars);
}
tfree(copyval); /*DG: must free ss any way to avoid cp_unquote memory leak */
tfree(name); /* va: cp_unquote memory leak: free name for every loop */
}
if (name)
tfree(name);
return (vars);
}
struct dvec *
vec_get(const char *vec_name)
{
struct dvec *d, *end = NULL, *newv = NULL;
struct plot *pl;
char buf[BSIZE_SP], *s, *wd, *word, *whole, *name = NULL, *param;
int i = 0;
struct variable *vv;
wd = word = copy(vec_name); /* Gets mangled below... */
if (strchr(word, '.')) {
/* Snag the plot... */
for (i = 0, s = word; *s != '.'; i++, s++)
buf[i] = *s;
buf[i] = '\0';
if (cieq(buf, "all")) {
word = ++s;
pl = NULL; /* NULL pl signifies a wildcard. */
} else {
for (pl = plot_list;
pl && !plot_prefix(buf, pl->pl_typename);
pl = pl->pl_next)
;
if (pl) {
word = ++s;
} else {
/* This used to be an error... */
pl = plot_cur;
}
}
} else {
pl = plot_cur;
}
if (pl) {
d = vec_fromplot(word, pl);
if (!d)
d = vec_fromplot(word, &constantplot);
} else {
for (pl = plot_list; pl; pl = pl->pl_next) {
if (cieq(pl->pl_typename, "const"))
continue;
d = vec_fromplot(word, pl);
if (d) {
if (end)
end->v_link2 = d;
else
newv = d;
for (end = d; end->v_link2; end = end->v_link2)
;
}
}
d = newv;
if (!d) {
fprintf(cp_err,
"Error: plot wildcard (name %s) matches nothing\n",
word);
tfree(wd); /* MW. I don't want core leaks here */
return (NULL);
}
}
if (!d && (*word == SPECCHAR)) {
/* This is a special quantity... */
if (ft_nutmeg) {
fprintf(cp_err,
"Error: circuit parameters only available with spice\n");
tfree(wd); /* MW. Memory leak fixed again */
return (NULL); /* va: use NULL */
}
whole = copy(word);
name = ++word;
for (param = name; *param && (*param != '['); param++)
;
if (*param) {
*param++ = '\0';
for (s = param; *s && *s != ']'; s++)
;
*s = '\0';
} else {
param = NULL;
}
if (ft_curckt) {
/*
* This is what is done in case of "alter r1 resistance = 1234"
* r1 resistance, 0
* if_setparam(ft_curckt->ci_ckt, &dev, param, dv, do_model);
*/
/* vv = if_getparam (ft_curckt->ci_ckt, &name, param, 0, 0); */
vv = if_getparam(ft_curckt->ci_ckt, &name, param, 0, 0);
if (!vv) {
tfree(whole);
tfree(wd);
return (NULL);
}
} else {
fprintf(cp_err, "Error: No circuit loaded.\n");
tfree(whole);
tfree(wd);
return (NULL);
}
d = alloc(struct dvec);
ZERO(d, struct dvec);
d->v_name = copy(whole); /* MW. The same as word before */
d->v_type = SV_NOTYPE;
d->v_flags |= VF_REAL; /* No complex values yet... */
d->v_realdata = TMALLOC(double, 1);
d->v_length = 1;
/* In case the represented variable is a REAL vector this takes
* the actual value of the first element of the linked list which
* does not make sense.
* This is an error.
*/
/* This will copy the contents of the structure vv in another structure
* dvec (FTEDATA.H) that do not have INTEGER so that those parameters
* defined as IF_INTEGER are not given their value when using
* print @pot[pos_node]
* To fix this, it is necessary to define:
* OPU( "pos_node", POT_QUEST_POS_NODE, IF_REAL,"Positive node of potenciometer"),
* int POTnegNode; // number of negative node of potenciometer (Nodo_3)
* case POT_QUEST_POS_NODE:
* value->rValue = (double)fast->POTposNode;
* return (OK);
* Works but with the format 1.00000E0
*/
/* We must make a change in format between the data that carries a variable to
* put in a dvec.
*/
/*
* #define va_bool va_V.vV_bool
* #define va_num va_V.vV_num
* #define va_real va_V.vV_real
* #define va_string va_V.vV_string
* #define va_vlist va_V.vV_list
* enum cp_types {
* CP_BOOL,
* CP_NUM,
* CP_REAL,
* CP_STRING,
* CP_LIST
° };
*/
/* The variable is a vector */
if (vv->va_type == CP_LIST) {
/* Compute the length of the vector,
* used with the parameters of isrc and vsrc
*/
struct variable *nv;
double *list;
list = TMALLOC(double, 1);
nv = alloc(struct variable);
nv = vv->va_vlist;
for (i = 1; ; i++) {
list = TREALLOC(double, list, i);
list[i-1] = nv->va_real;
nv = nv->va_next;
if (!nv)
break;
}
d->v_realdata = list;
d->v_length = i;
/* To be able to identify the vector to represent
* belongs to a special "conunto" and should be printed in a
* special way.
*/
d->v_dims[1] = 1;
} else if (vv->va_type == CP_NUM) { /* Variable is an integer */
*d->v_realdata = (double) vv->va_num;
} else if (vv->va_type == CP_REAL) { /* Variable is a real */
if (!(vv->va_next)) {
/* Only a real data
* usually normal
*/
*d->v_realdata = vv->va_real;
} else {
/* Real data set
* When you print a model @ [all]
* Just print numerical values, not the string
*/
struct variable *nv;
/* We go to print the list of values
* nv->va_name = Parameter description
* nv->va_string = Parameter
* nv->va_real= Value
*/
nv = vv;
for (i = 1; ; i++) {
switch (nv->va_type) {
case CP_REAL:
fprintf(stdout, "%s=%g\n", nv->va_name, nv->va_real);
break;
case CP_STRING:
fprintf(stdout, "%s=%s\n", nv->va_name, nv->va_string);
break;
case CP_NUM:
fprintf(stdout, "%s=%d\n", nv->va_name, nv->va_num);
break;
default: {
fprintf(stderr, "ERROR: enumeration value `CP_BOOL' or `CP_LIST' not handled in vec_get\nAborting...\n");
controlled_exit(EXIT_FAILURE);
}
}
nv = nv->va_next;
if (!nv)
break;
}
/* To distinguish those does not take anything for print screen to
* make a print or M1 @ @ M1 [all] leaving only the correct data
* and not the last
*/
d->v_rlength = 1;
}
}
tfree(vv->va_name);
tfree(vv); /* va: tfree vv->va_name and vv (avoid memory leakages) */
tfree(wd);
vec_new(d);
tfree(whole);
return (d);
}
static int
ReadTxL(TXLinstance *tx, CKTcircuit *ckt)
{
double R, L, G, C, l;
char *p, *n;
NODE *nd;
ETXLine *et;
TXLine *t, *t2;
RLINE *line;
ERLINE *er;
double LL = 1e-12;
NG_IGNORE(ckt);
p = tx->in_node_name;
n = tx->out_node_name;
line = TMALLOC(RLINE, 1);
er = TMALLOC(ERLINE, 1);
et = TMALLOC(ETXLine, 1);
t = TMALLOC(TXLine, 1);
t2 = TMALLOC(TXLine, 1);
tx->txline = t;
tx->txline2 = t2;
t->newtp = 0;
t2->newtp = 0;
t->vi_head = t->vi_tail = NULL;
nd = insert_node(p);
et->link = nd->tptr;
nd->tptr = et;
et->line = t;
t->in_node = nd;
t2->in_node = nd;
er->link = nd->rlptr;
nd->rlptr = er;
er->rl = line;
line->in_node = nd;
et = TMALLOC(ETXLine, 1);
nd = insert_node(n);
et->link = nd->tptr;
nd->tptr = et;
et->line = t;
t->out_node = nd;
t2->out_node = nd;
er = TMALLOC(ERLINE, 1);
er->link = nd->rlptr;
nd->rlptr = er;
er->rl = line;
line->out_node = nd;
t->dc1 = t->dc2 = 0.0;
t2->dc1 = t2->dc2 = 0.0;
t->lsl = 0;
t2->lsl = 0;
l = 0.0;
R = tx->TXLmodPtr->R;
L = tx->TXLmodPtr->L;
L = MAX(L, LL);
C = tx->TXLmodPtr->C;
G = tx->TXLmodPtr->G;
if (tx->TXLlengthgiven == TRUE)
l = tx->TXLlength;
else l = tx->TXLmodPtr->length;
if (l == 0.0) {
fprintf(stderr, "(Error) transmission line of zero length\n");
controlled_exit(EXIT_FAILURE);
}
else {
if (R / L < 5.0e+5) {
line->g = 1.0e+2;
if (G < 1.0e-2) {
t->lsl = 1; /* lossless line */
t->taul = sqrt(C * L) * l * 1.0e12;
t->h3_aten = t->sqtCdL = sqrt(C / L);
t->h2_aten = 1.0;
t->h1C = 0.0;
}
}
else line->g = 1.0 / (R * l);
}
if (! t->lsl)
main_pade(R, L, G, C, l, t);
return(1);
}
static int
find_roots(double a1, double a2, double a3, double *x1, double *x2, double *x3)
{
double x, t;
double p, q;
q = (a1*a1-3.0*a2) / 9.0;
p = (2.0*a1*a1*a1-9.0*a1*a2+27.0*a3) / 54.0;
t = q*q*q - p*p;
if (t >= 0.0) {
t = acos(p /(q * sqrt(q)));
x = -2.0*sqrt(q)*cos(t / 3.0) - a1/3.0;
} else {
if (p > 0.0) {
t = pow(sqrt(-t)+p, 1.0 / 3.0);
x = -(t + q / t) - a1/3.0;
} else if (p == 0.0) {
x = -a1/3.0;
} else {
t = pow(sqrt(-t)-p, 1.0 / 3.0);
x = (t + q / t) - a1/3.0;
}
}
{
double x_backup = x;
int i = 0;
for (t = root3(a1, a2, a3, x); ABS(t-x) > 5.0e-4;
t = root3(a1, a2, a3, x))
if (++i == 32) {
x = x_backup;
break;
} else
x = t;
}
/*
x = a1;
i = 0;
j = 0;
for (t = root3(a1, a2, a3, x); ABS(t-x) > epsi;
t = root3(a1, a2, a3, x)) {
x = t;
i++;
if (i > 1000) {
x = 0.5 * (x + root3(a1, a2, a3, x));
j++;
if (j == 3)
break;
i = 0;
}
}
*/
*x1 = x;
div3(a1, a2, a3, x, &a1, &a2);
t = a1 * a1 - 4.0 * a2;
if (t < 0) {
printf("***** Two Imaginary Roots in Characteristic Admittance.\n");
controlled_exit(EXIT_FAILURE);
}
t *= 1.0e-18;
t = sqrt(t) * 1.0e9;
if (a1 >= 0.0)
*x2 = t = -0.5 * (a1 + t);
else
*x2 = t = -0.5 * (a1 - t);
*x3 = a2 / t;
/*
*x2 = 0.5 * (-a1 + t);
*x3 = 0.5 * (-a1 - t);
*/
return(1);
}
void
com_quit(wordlist *wl)
{
int exitcode = EXIT_NORMAL;
bool noask =
(wl && wl->wl_word && 1 == sscanf(wl->wl_word, "%d", &exitcode)) ||
(wl && wl->wl_word && cieq(wl->wl_word, "noask")) ||
cp_getvar("noaskquit", CP_BOOL, NULL);
/* update screen and reset terminal */
gr_clean();
cp_ccon(FALSE);
/* Make sure the guy really wants to quit. */
if (!ft_nutmeg)
if (!noask && !confirm_quit())
return;
/* start to clean up the mess */
#ifdef SHARED_MODULE
{
wordlist all = { "all", NULL, NULL };
wordlist star = { "*", NULL, NULL };
// com_remcirc(NULL);
com_destroy(&all);
com_unalias(&star);
com_undefine(&star);
cp_remvar("history");
cp_remvar("noglob");
cp_remvar("brief");
cp_remvar("sourcepath");
cp_remvar("program");
cp_remvar("prompt");
}
#endif
#ifdef EXPERIMENTAL_CODE
/* Destroy CKT when quit. Add by Gong Ding, [email protected] */
if (!ft_nutmeg) {
struct circ *cc;
for (cc = ft_circuits; cc; cc = cc->ci_next)
if (SIMinfo.deleteCircuit)
SIMinfo.deleteCircuit(cc->ci_ckt);
}
#endif
#ifdef SHARED_MODULE
/* Destroy CKT when quit. */
if (!ft_nutmeg) {
while(ft_curckt)
com_remcirc(NULL);
}
#endif
DevSwitch(NULL);
DevSwitch(NULL);
/* then go away */
#ifdef SHARED_MODULE
cp_destroy_keywords();
destroy_ivars();
#endif
byemesg();
#ifdef SHARED_MODULE
destroy_const_plot();
spice_destroy_devices();
#endif
#ifdef SHARED_MODULE
/* add 1000 to notify that we exit from 'quit' */
controlled_exit(1000 + exitcode);
#else
exit(exitcode);
#endif
}
