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 }