bool
cp_istrue(wordlist *wl)
{
struct dvec *v;
struct pnode *names;
bool rv;
/* First do all the csh-type stuff here... */
wl = wl_copy(wl);
wl = cp_variablesubst(wl);
wl = cp_bquote(wl);
cp_striplist(wl);
names = ft_getpnames(wl, TRUE);
wl_free(wl);
v = ft_evaluate(names);
rv = !vec_iszero(v);
/* va: garbage collection for v, if pnode names is no simple value */
if (names->pn_value == NULL && v != NULL)
vec_free(v);
free_pnode(names); /* free also v, if pnode names is simple value */
return rv;
}
bool
cp_istrue(wordlist *wl)
{
int i;
struct dvec *v;
struct pnode *pn;
/* fprintf(stderr, "isTRUE: "); wl_print(wl, stderr); fprintf(stderr, "\n"); */
/* First do all the csh-type stuff here... */
wl = wl_copy(wl);
wl = cp_variablesubst(wl);
wl = cp_bquote(wl);
cp_striplist(wl);
pn = ft_getpnames(wl, TRUE);
wl_free(wl);
v = ft_evaluate(pn);
/* It makes no sense to say while (all), but what the heck... */
while (v) {
if (isreal(v)) {
for (i = 0; i < v->v_length; i++)
if (v->v_realdata[i] != 0.0) {
free_pnode(pn);
return (TRUE);
}
} else {
for (i = 0; i < v->v_length; i++)
if ((realpart(&v->v_compdata[i]) != 0.0) ||
(imagpart(&v->v_compdata[i]) != 0.0)) {
free_pnode(pn);
return (TRUE);
}
}
v = v->v_link2;
}
free_pnode(pn);
return (FALSE);
}
bool
cp_istrue(wordlist *wl)
{
int i;
struct dvec *v;
struct pnode *names;
/* First do all the csh-type stuff here... */
wl = wl_copy(wl);
wl = cp_variablesubst(wl);
wl = cp_bquote(wl);
cp_striplist(wl);
names = ft_getpnames(wl, TRUE);
wl_free(wl);
v = ft_evaluate(names);
for (; v; v = v->v_link2)
if (isreal(v)) {
for (i = 0; i < v->v_length; i++)
if (v->v_realdata[i] != 0.0) {
free_pnode(names);
return (TRUE);
}
} else {
for (i = 0; i < v->v_length; i++)
if ((realpart(v->v_compdata[i]) != 0.0) ||
(imagpart(v->v_compdata[i]) != 0.0)) {
free_pnode(names);
return (TRUE);
}
}
free_pnode(names);
return (FALSE);
}
int
fourier(wordlist *wl, struct plot *current_plot)
{
struct dvec *time, *vec;
struct pnode *pn, *names;
double *ff, fundfreq, *data = NULL;
int nfreqs, fourgridsize, polydegree;
double *freq, *mag, *phase, *nmag, *nphase; /* Outputs from CKTfour */
double thd, *timescale = NULL;
char *s;
int i, err, fw;
char xbuf[20];
int shift;
int rv = 1;
char newvecname[32];
struct dvec *n;
int newveccount = 1;
static int callstof = 1;
if (!current_plot)
return 1;
sprintf(xbuf, "%1.1e", 0.0);
shift = (int) strlen(xbuf) - 7;
if (!current_plot || !current_plot->pl_scale) {
fprintf(cp_err, "Error: no vectors loaded.\n");
return 1;
}
if (!cp_getvar("nfreqs", CP_NUM, &nfreqs) || nfreqs < 1)
nfreqs = 10;
if (!cp_getvar("polydegree", CP_NUM, &polydegree) || polydegree < 0)
polydegree = 1;
if (!cp_getvar("fourgridsize", CP_NUM, &fourgridsize) || fourgridsize < 1)
fourgridsize = DEF_FOURGRIDSIZE;
time = current_plot->pl_scale;
if (!isreal(time)) {
fprintf(cp_err, "Error: fourier needs real time scale\n");
return 1;
}
s = wl->wl_word;
if ((ff = ft_numparse(&s, FALSE)) == NULL || (*ff <= 0.0)) {
fprintf(cp_err, "Error: bad fund freq %s\n", wl->wl_word);
return 1;
}
fundfreq = *ff;
freq = TMALLOC(double, nfreqs);
mag = TMALLOC(double, nfreqs);
phase = TMALLOC(double, nfreqs);
nmag = TMALLOC(double, nfreqs);
nphase = TMALLOC(double, nfreqs);
wl = wl->wl_next;
names = ft_getpnames(wl, TRUE);
for (pn = names; pn; pn = pn->pn_next) {
vec = ft_evaluate(pn);
for (; vec; vec = vec->v_link2) {
if (vec->v_length != time->v_length) {
fprintf(cp_err,
"Error: lengths don't match: %d, %d\n",
vec->v_length, time->v_length);
continue;
}
if (!isreal(vec)) {
fprintf(cp_err, "Error: %s isn't real!\n", vec->v_name);
continue;
}
if (polydegree) {
double *dp, d;
/* Build the grid... */
timescale = TMALLOC(double, fourgridsize);
data = TMALLOC(double, fourgridsize);
dp = ft_minmax(time, TRUE);
/* Now get the last fund freq... */
d = 1 / fundfreq; /* The wavelength... */
if (dp[1] - dp[0] < d) {
fprintf(cp_err, "Error: wavelength longer than time span\n");
goto done;
} else if (dp[1] - dp[0] > d) {
dp[0] = dp[1] - d;
}
d = (dp[1] - dp[0]) / fourgridsize;
for (i = 0; i < fourgridsize; i++)
timescale[i] = dp[0] + i * d;
/* Now interpolate the data... */
if (!ft_interpolate(vec->v_realdata, data,
time->v_realdata, vec->v_length,
timescale, fourgridsize,
polydegree)) {
fprintf(cp_err, "Error: can't interpolate\n");
goto done;
}
} else {
fourgridsize = vec->v_length;
data = vec->v_realdata;
timescale = time->v_realdata;
}
err = CKTfour(fourgridsize, nfreqs, &thd, timescale,
data, fundfreq, freq, mag, phase, nmag,
nphase);
if (err != OK) {
ft_sperror(err, "fourier");
goto done;
}
fprintf(cp_out, "Fourier analysis for %s:\n", vec->v_name);
fprintf(cp_out,
" No. Harmonics: %d, THD: %g %%, Gridsize: %d, Interpolation Degree: %d\n\n",
nfreqs, thd, fourgridsize,
polydegree);
/* Each field will have width cp_numdgt + 6 (or 7
* with HP-UX) + 1 if there is a - sign.
*/
fw = ((cp_numdgt > 0) ? cp_numdgt : 6) + 5 + shift;
fprintf(cp_out, "Harmonic %-*s %-*s %-*s %-*s %-*s\n",
fw, "Frequency", fw, "Magnitude",
fw, "Phase", fw, "Norm. Mag",
fw, "Norm. Phase");
fprintf(cp_out, "-------- %-*s %-*s %-*s %-*s %-*s\n",
fw, "---------", fw, "---------",
fw, "-----", fw, "---------",
fw, "-----------");
for (i = 0; i < nfreqs; i++) {
char *pnumfr, *pnumma, *pnumph, *pnumnm, *pnumnp;
pnumfr = pnum(freq[i]);
pnumma = pnum(mag[i]);
pnumph = pnum(phase[i]);
pnumnm = pnum(nmag[i]);
pnumnp = pnum(nphase[i]);
fprintf(cp_out,
" %-4d %-*s %-*s %-*s %-*s %-*s\n",
i,
fw, pnumfr,
fw, pnumma,
fw, pnumph,
fw, pnumnm,
fw, pnumnp);
tfree(pnumfr);
tfree(pnumma);
tfree(pnumph);
tfree(pnumnm);
tfree(pnumnp);
}
fputs("\n", cp_out);
/* generate name for new vector, using vec->name */
sprintf(newvecname, "fourier%d%d", callstof, newveccount);
/* create and assign a new vector n */
/* with size 3 * nfreqs in current plot */
n = alloc(struct dvec);
ZERO(n, struct dvec);
n->v_name = copy(newvecname);
n->v_type = SV_NOTYPE;
n->v_flags = (VF_REAL | VF_PERMANENT);
n->v_length = 3 * nfreqs;
n->v_numdims = 2;
n->v_dims[0] = 3;
n->v_dims[1] = nfreqs;
n->v_realdata = TMALLOC(double, n->v_length);
vec_new(n);
/* store data in vector: freq, mag, phase */
for (i = 0; i < nfreqs; i++) {
n->v_realdata[i] = freq[i];
n->v_realdata[i + nfreqs] = mag[i];
n->v_realdata[i + 2 * nfreqs] = phase[i];
}
newveccount++;
if (polydegree) {
tfree(timescale);
tfree(data);
}
timescale = NULL;
data = NULL;
}
}
void
com_print(wordlist *wl)
{
struct dvec *v, *lv = NULL, *bv, *nv, *vecs = NULL;
int i, j, ll, width = DEF_WIDTH, height = DEF_HEIGHT, npoints, lineno;
struct pnode *pn, *names;
struct plot *p;
bool col = TRUE, nobreak = FALSE, noprintscale, plotnames = FALSE;
bool optgiven = FALSE;
char *s, *buf, *buf2; /*, buf[BSIZE_SP], buf2[BSIZE_SP];*/
char numbuf[BSIZE_SP], numbuf2[BSIZE_SP]; /* Printnum buffers */
int ngood;
if (wl == NULL)
return;
buf = TMALLOC(char, BSIZE_SP);
buf2 = TMALLOC(char, BSIZE_SP);
if (eq(wl->wl_word, "col")) {
col = TRUE;
optgiven = TRUE;
wl = wl->wl_next;
} else if (eq(wl->wl_word, "line")) {
col = FALSE;
optgiven = TRUE;
wl = wl->wl_next;
}
ngood = 0;
names = ft_getpnames(wl, TRUE);
for (pn = names; pn; pn = pn->pn_next) {
if ((v = ft_evaluate(pn)) == NULL)
continue;
if (!vecs)
vecs = lv = v;
else
lv->v_link2 = v;
for (lv = v; lv->v_link2; lv = lv->v_link2)
;
ngood += 1;
}
if (!ngood)
goto done;
/* See whether we really have to print plot names. */
for (v = vecs; v; v = v->v_link2)
if (vecs->v_plot != v->v_plot) {
plotnames = TRUE;
break;
}
if (!optgiven) {
/* Figure out whether col or line should be used... */
col = FALSE;
for (v = vecs; v; v = v->v_link2)
if (v->v_length > 1) {
col = TRUE;
/* Improvement made to print cases @[sin] = (0 12 13 100K) */
if ((v->v_plot->pl_scale && v->v_length != v->v_plot->pl_scale->v_length) && (*(v->v_name) == '@'))
{
col = FALSE;
}
break;
}
/* With this I have found that the vector has less elements than the SCALE vector
* in the linked PLOT. But now I must make sure in case of a print @vin[sin] or
* @vin[pulse]
* for it appear that the v->v_name begins with '@'
* And then be in this case.
*/
}
out_init();
if (!col) {
if (cp_getvar("width", CP_NUM, &i))
width = i;
if (width < 60)
width = 60;
if (width > BSIZE_SP - 2)
buf = TREALLOC(char, buf, width + 1);
for (v = vecs; v; v = v->v_link2) {
char *basename = vec_basename(v);
if (plotnames)
(void) sprintf(buf, "%s.%s", v->v_plot->pl_typename, basename);
else
(void) strcpy(buf, basename);
tfree(basename);
for (s = buf; *s; s++)
;
s--;
while (isspace(*s)) {
*s = '\0';
s--;
}
ll = 10;
/* v->v_rlength = 1 when it comes to make a print @ M1 and does not want to come out on screen
* Multiplier factor [m]=1
* @M1 = 0,00e+00
* In any other case rlength not used for anything and only applies in the copy of the vectors.
*/
if (v->v_rlength == 0) {
if (v->v_length == 1) {
if (isreal(v)) {
printnum(numbuf, *v->v_realdata);
out_printf("%s = %s\n", buf, numbuf);
} else {
printnum(numbuf, realpart(v->v_compdata[0]));
printnum(numbuf2, imagpart(v->v_compdata[0]));
out_printf("%s = %s,%s\n", buf, numbuf, numbuf2);
}
} else {
out_printf("%s = ( ", buf);
for (i = 0; i < v->v_length; i++)
if (isreal(v)) {
printnum(numbuf, v->v_realdata[i]);
(void) strcpy(buf, numbuf);
out_send(buf);
ll += (int) strlen(buf);
ll = (ll + 7) / 8;
ll = ll * 8 + 1;
if (ll > width) {
out_send("\n\t");
ll = 9;
} else {
out_send("\t");
}
} else {
/*DG*/
printnum(numbuf, realpart(v->v_compdata[i]));
printnum(numbuf2, imagpart(v->v_compdata[i]));
(void) sprintf(buf, "%s,%s", numbuf, numbuf2);
out_send(buf);
ll += (int) strlen(buf);
ll = (ll + 7) / 8;
ll = ll * 8 + 1;
if (ll > width) {
out_send("\n\t");
ll = 9;
} else {
out_send("\t");
}
}
out_send(")\n");
} //end if (v->v_length == 1)
} //end if (v->v_rlength == 1)
} // end for loop
} else { /* Print in columns. */
if (cp_getvar("width", CP_NUM, &i))
void
com_compose(wordlist *wl)
{
double start = 0.0;
double stop = 0.0;
double step = 0.0;
double lin = 0.0;
double center;
double span;
double mean, sd;
bool startgiven = FALSE, stopgiven = FALSE, stepgiven = FALSE;
bool lingiven = FALSE;
bool loggiven = FALSE, decgiven = FALSE, gaussgiven = FALSE;
bool randmgiven = FALSE;
bool spangiven = FALSE;
bool centergiven = FALSE;
bool meangiven = FALSE;
bool poolgiven = FALSE;
bool sdgiven = FALSE;
int log, dec, gauss, randm;
char *pool;
int i;
char *s, *var, *val;
double *td, tt;
double *data = NULL;
ngcomplex_t *cdata = NULL;
int length = 0;
int dim, type = SV_NOTYPE, blocksize;
bool realflag = TRUE;
int dims[MAXDIMS];
struct dvec *result, *vecs = NULL, *v, *lv = NULL;
struct pnode *pn, *names = NULL;
bool reverse = FALSE;
char *resname = cp_unquote(wl->wl_word);
vec_remove(resname);
wl = wl->wl_next;
if (eq(wl->wl_word, "values")) {
/* Build up the vector from the rest of the line... */
wl = wl->wl_next;
names = ft_getpnames(wl, TRUE);
if (!names)
goto done;
for (pn = names; pn; pn = pn->pn_next) {
if ((v = ft_evaluate(pn)) == NULL)
goto done;
if (!vecs)
vecs = lv = v;
else
lv->v_link2 = v;
for (lv = v; lv->v_link2; lv = lv->v_link2)
;
}
/* Now make sure these are all of the same dimensionality. We
* can coerce the sizes...
*/
dim = vecs->v_numdims;
if (dim < 2)
dim = (vecs->v_length > 1) ? 1 : 0;
if (dim == MAXDIMS) {
fprintf(cp_err, "Error: max dimensionality is %d\n",
MAXDIMS);
goto done;
}
for (v = vecs; v; v = v->v_link2)
if (v->v_numdims < 2)
v->v_dims[0] = v->v_length;
for (v = vecs->v_link2, length = 1; v; v = v->v_link2) {
i = v->v_numdims;
if (i < 2)
i = (v->v_length > 1) ? 1 : 0;
if (i != dim) {
fprintf(cp_err,
"Error: all vectors must be of the same dimensionality\n");
goto done;
}
length++;
if (iscomplex(v))
realflag = FALSE;
}
for (i = 0; i < dim; i++) {
dims[i] = vecs->v_dims[i];
for (v = vecs->v_link2; v; v = v->v_link2)
if (v->v_dims[i] > dims[i])
dims[i] = v->v_dims[i];
}
dim++;
dims[dim - 1] = length;
for (i = 0, blocksize = 1; i < dim - 1; i++)
blocksize *= dims[i];
if (realflag)
data = TMALLOC(double, length * blocksize);
else