Jspice3
cmath4.c
Go to the documentation of this file.
1 /***************************************************************************
2 JSPICE3 adaptation of Spice3e2 - Copyright (c) Stephen R. Whiteley 1992
3 Copyright 1990 Regents of the University of California. All rights reserved.
4 Authors: 1985 Wayne A. Christopher
5  1992 Stephen R. Whiteley
6 ****************************************************************************/
7 
8 /*
9  * Routines to do complex mathematical functions. These routines require
10  * the -lm libraries. We sacrifice a lot of space to be able
11  * to avoid having to do a seperate call for every vector element,
12  * but it pays off in time savings. These routines should never
13  * allow FPE's to happen.
14  *
15  * Complex functions are called as follows:
16  * cx_something(data, type, length, &newlength, &newtype),
17  * and return a char * that is cast to complex or double.
18  */
19 
20 #include "spice.h"
21 #include "ftedefs.h"
22 #include "ftecmath.h"
23 
24 #ifdef __STDC__
25 static void polyderiv(double*,int);
26 #else
27 static void polyderiv();
28 #endif
29 
30 
31 char *
32 cx_and(data1, data2, datatype1, datatype2, length)
33 
34 char *data1, *data2;
35 short datatype1, datatype2;
36 {
37  double *dd1 = (double *) data1;
38  double *dd2 = (double *) data2;
39  double *d;
40  complex *cc1 = (complex *) data1;
41  complex *cc2 = (complex *) data2;
42  complex c1, c2;
43  int i;
44 
45  d = alloc_d(length);
46  if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
47  for (i = 0; i < length; i++)
48  d[i] = dd1[i] && dd2[i];
49  }
50  else {
51  for (i = 0; i < length; i++) {
52  if (datatype1 == VF_REAL) {
53  realpart(&c1) = dd1[i];
54  imagpart(&c1) = 0.0;
55  }
56  else {
57  realpart(&c1) = realpart(&cc1[i]);
58  imagpart(&c1) = imagpart(&cc1[i]);
59  }
60  if (datatype2 == VF_REAL) {
61  realpart(&c2) = dd2[i];
62  imagpart(&c2) = 0.0;
63  }
64  else {
65  realpart(&c2) = realpart(&cc2[i]);
66  imagpart(&c2) = imagpart(&cc2[i]);
67  }
68  d[i] = ((realpart(&c1) && realpart(&c2)) &&
69  (imagpart(&c1) && imagpart(&c2)));
70  }
71  }
72  return ((char *) d);
73 }
74 
75 
76 char *
77 cx_or(data1, data2, datatype1, datatype2, length)
78 
79 char *data1, *data2;
80 short datatype1, datatype2;
81 {
82  double *dd1 = (double *) data1;
83  double *dd2 = (double *) data2;
84  double *d;
85  complex *cc1 = (complex *) data1;
86  complex *cc2 = (complex *) data2;
87  complex c1, c2;
88  int i;
89 
90  d = alloc_d(length);
91  if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
92  for (i = 0; i < length; i++)
93  d[i] = dd1[i] || dd2[i];
94  }
95  else {
96  for (i = 0; i < length; i++) {
97  if (datatype1 == VF_REAL) {
98  realpart(&c1) = dd1[i];
99  imagpart(&c1) = 0.0;
100  }
101  else {
102  realpart(&c1) = realpart(&cc1[i]);
103  imagpart(&c1) = imagpart(&cc1[i]);
104  }
105  if (datatype2 == VF_REAL) {
106  realpart(&c2) = dd2[i];
107  imagpart(&c2) = 0.0;
108  }
109  else {
110  realpart(&c2) = realpart(&cc2[i]);
111  imagpart(&c2) = imagpart(&cc2[i]);
112  }
113  d[i] = ((realpart(&c1) || realpart(&c2)) &&
114  (imagpart(&c1) || imagpart(&c2)));
115  }
116  }
117  return ((char *) d);
118 }
119 
120 
121 char *
122 cx_not(data, type, length, newlength, newtype)
123 
124 char *data;
125 short type;
126 int length;
127 int *newlength;
128 short *newtype;
129 {
130  double *d;
131  double *dd = (double *) data;
132  complex *cc = (complex *) data;
133  int i;
134 
135  d = alloc_d(length);
136  *newtype = VF_REAL;
137  *newlength = length;
138  if (type == VF_COMPLEX) {
139  for (i = 0; i < length; i++) {
140  /* gcc doens't like !double */
141  d[i] = realpart(&cc[i]) ? 0 : 1;
142  d[i] = imagpart(&cc[i]) ? 0 : 1;
143  }
144  }
145  else {
146  for (i = 0; i < length; i++)
147  d[i] = ! dd[i];
148  }
149  return ((char *) d);
150 }
151 
152 
153 /* This is a strange function. What we do is fit a polynomial to the
154  * curve, of degree $polydegree, and then evaluate it at the points
155  * in the time scale. What we do is this: for every set of points that
156  * we fit a polynomial to, fill in as much of the new vector as we can
157  * (i.e, between the last value of the old scale we went from to this
158  * one). At the ends we just use what we have... We have to detect
159  * badness here too...
160  * Note that we pass arguments differently for this one cx_ function...
161  */
162 
163 char *
164 cx_interpolate(data, type, length, newlength, newtype, pl, newpl)
165 
166 char *data;
167 short type;
168 int length;
169 int *newlength;
170 short *newtype;
171 struct plot *pl, *newpl;
172 {
173  struct dvec *ns, *os;
174  double *d;
175  int degree;
176  register int i, oincreasing = 1, nincreasing = 1;
177  extern char *kw_polydegree;
178 
179  /* First do some sanity checks. */
180  if (!pl || !pl->pl_scale || !newpl || !newpl->pl_scale) {
181  fprintf(cp_err, "Internal error: cx_interpolate: bad scale\n");
182  return (NULL);
183  }
184  ns = newpl->pl_scale;
185  os = pl->pl_scale;
186  if (iscomplex(ns)) {
187  fprintf(cp_err, "Error: new scale has complex data\n");
188  return (NULL);
189  /*
190  for (i = ns->v_length - 1; i >= 0; i--)
191  if (imagpart(&ns->v_compdata[i])) {
192  fprintf(cp_err,
193  "Error: new scale has complex data\n");
194  return (NULL);
195  }
196  osbuf = alloc_d(olen);
197  */
198  }
199  if (iscomplex(os)) {
200  fprintf(cp_err, "Error: old scale has complex data\n");
201  return (NULL);
202  /*
203  for (i = os->v_length - 1; i >= 0; i--)
204  if (imagpart(&os->v_compdata[i])) {
205  fprintf(cp_err,
206  "Error: old scale has complex data\n");
207  return (NULL);
208  }
209  nsbuf = alloc_d(nlen);
210  */
211  }
212 
213  if (length != os->v_length) {
214  fprintf(cp_err, "Error: lengths don't match\n");
215  return (NULL);
216  }
217  if (type != VF_REAL) {
218  fprintf(cp_err, "Error: argument has complex data\n");
219  return (NULL);
220  }
221 
222  /* Now make sure that either both scales are strictly increasing or
223  * both are strictly decreasing.
224  */
225  if (os->v_realdata[0] < os->v_realdata[1])
226  oincreasing = true;
227  else
228  oincreasing = false;
229  for (i = 0; i < os->v_length - 1; i++)
230  if ((os->v_realdata[i] < os->v_realdata[i + 1])
231  != oincreasing) {
232  fprintf(cp_err, "Error: old scale not monotonic\n");
233  return (NULL);
234  }
235  if (ns->v_realdata[0] < ns->v_realdata[1])
236  nincreasing = true;
237  else
238  nincreasing = false;
239  for (i = 0; i < ns->v_length - 1; i++)
240  if ((ns->v_realdata[i] < ns->v_realdata[i + 1])
241  != nincreasing) {
242  fprintf(cp_err, "Error: new scale not monotonic\n");
243  return (NULL);
244  }
245 
246  *newtype = VF_REAL;
247  *newlength = ns->v_length;
248  d = alloc_d(ns->v_length);
249 
250  if (!cp_getvar(kw_polydegree, VT_NUM, (char *) &degree))
251  degree = 1;
252 
253  if (!ft_interpolate((double *) data, d, os->v_realdata, os->v_length,
254  ns->v_realdata, ns->v_length, degree)) {
255  return (NULL);
256  }
257 
258  return ((char *) d);
259 }
260 
261 
262 char *
263 cx_deriv(data, type, length, newlength, newtype, pl, newpl)
264 
265 char *data;
266 short type;
267 int length;
268 int *newlength;
269 short *newtype;
270 struct plot *pl, *newpl;
271 {
272  double *scratch;
273  double *spare;
274  double x;
275  int i, j, k;
276  int degree;
277  int n;
278 
279  /* First do some sanity checks. */
280  if (!pl || !pl->pl_scale || !newpl || !newpl->pl_scale) {
281  fprintf(cp_err, "Internal error: cx_deriv: bad scale\n");
282  return (NULL);
283  }
284 
285  if (!cp_getvar("dpolydegree", VT_NUM, (char *) &degree))
286  degree = 2; /* default quadratic */
287 
288  n = degree + 1;
289 
290  spare = alloc_d(n);
291  scratch = alloc_d(n * (n + 1));
292 
293  *newlength = length;
294  *newtype = type;
295 
296  if (type == VF_COMPLEX) {
297  complex *c_outdata, *c_indata;
298  double *r_coefs, *i_coefs;
299 
300  r_coefs = alloc_d(n);
301  i_coefs = alloc_d(n);
302  c_indata = (complex *) data;
303  c_outdata = alloc_c(length);
304  k = 0;
305  for (i = degree; i < length; i += 1) {
306 
307  /* real */
308  for (j = i; j < i + n; j++)
309  spare[j] = c_indata[j].cx_real;
310  if (!ft_polyfit(pl->pl_scale->v_realdata + i - degree, spare,
311  r_coefs, degree, scratch)) {
312  fprintf(stderr, "ft_polyfit @ %d failed\n", i);
313  }
314  polyderiv(r_coefs, degree);
315 
316  /* for loop gets the beginning part */
317  for (j = k; j <= i + degree / 2; j++) {
318  x = pl->pl_scale->v_realdata[j];
319  c_outdata[j].cx_real = ft_peval(x, r_coefs, degree - 1);
320  }
321 
322  /* imag */
323  for (j = i; j < i + n; j++)
324  spare[j] = c_indata[j].cx_imag;
325  if (!ft_polyfit(pl->pl_scale->v_realdata + i - degree, spare,
326  i_coefs, degree, scratch)) {
327  fprintf(stderr, "ft_polyfit @ %d failed\n", i);
328  }
329  polyderiv(i_coefs, degree);
330 
331  /* for loop gets the beginning part */
332  for (j = k; j <= i - degree / 2; j++) {
333  x = pl->pl_scale->v_realdata[j];
334  c_outdata[j].cx_imag = ft_peval(x, i_coefs, degree - 1);
335  }
336  k = j;
337  }
338 
339  /* get the tail */
340  for (j = k; j < length; j++) {
341  x = pl->pl_scale->v_realdata[j];
342  /* real */
343  c_outdata[j].cx_real = ft_peval(x, r_coefs, degree - 1);
344  /* imag */
345  c_outdata[j].cx_imag = ft_peval(x, i_coefs, degree - 1);
346  }
347 
348  tfree(r_coefs);
349  tfree(i_coefs);
350  return (char *) c_outdata;
351 
352  }
353 
354  else {
355  /* all-real case */
356  double *coefs;
357 
358  double *outdata, *indata;
359  double *scale;
360 
361  coefs = alloc_d(n);
362  indata = (double *) data;
363  outdata = alloc_d(length);
364  scale = alloc_d(length); /* XXX */
365  for (i = 0; i < length; i++)
366  scale[i] = pl->pl_scale->v_realdata[i];
367  k = 0;
368  for (i = degree; i < length; i += 1) {
369  if (!ft_polyfit(scale + i - degree, indata + i - degree,
370  coefs, degree, scratch)) {
371  fprintf(stderr, "ft_polyfit @ %d failed\n", i);
372  }
373  polyderiv(coefs, degree);
374 
375  /* for loop gets the beginning part */
376  for (j = k; j <= i - degree / 2; j++) {
377  x = pl->pl_scale->v_realdata[j];
378  outdata[j] = ft_peval(x, coefs, degree - 1);
379  }
380  k = j;
381  }
382 
383  for (j = k; j < length; j++) {
384  x = pl->pl_scale->v_realdata[j];
385  outdata[j] = ft_peval(x, coefs, degree - 1);
386  }
387 
388  tfree(coefs);
389  tfree(scale); /* XXX */
390  return (char *) outdata;
391  }
392 
393 }
394 
395 
396 static void
397 polyderiv(coeffs, degree)
398 
399 double *coeffs;
400 int degree;
401 {
402  int i;
403 
404  for (i = 0; i < degree; i++) {
405  coeffs[i] = (i + 1) * coeffs[i + 1];
406  }
407 }
static void polyderiv()
Definition: subckt.c:18
bool cp_getvar(char *n, int t, char *r)
Definition: help.c:184
#define VF_REAL
Definition: fteconst.h:39
#define alloc_c(len)
Definition: ftecmath.h:11
double ft_peval()
double cx_imag
Definition: cpstd.h:31
bool ft_polyfit()
Definition: cpstd.h:29
Definition: ftedata.h:61
bool ft_interpolate()
char * cx_real()
double cx_real
Definition: cpstd.h:30
FILE * cp_err
Definition: help.c:101
char * cx_or(char *data1, char *data2, short datatype1, short datatype2, length)
Definition: cmath4.c:77
Definition: cddefs.h:237
#define tfree(x)
Definition: cdmacs.h:22
struct dvec * pl_scale
Definition: ftedata.h:68
#define NULL
Definition: spdefs.h:121
Definition: types.c:18
#define VT_NUM
Definition: cpstd.h:61
Definition: ftedata.h:24
#define imagpart(cval)
Definition: cpstd.h:36
#define iscomplex(v)
Definition: ftedata.h:55
int v_length
Definition: ftedata.h:34
char * cx_and(char *data1, char *data2, short datatype1, short datatype2, length)
Definition: cmath4.c:32
char * cx_deriv(char *data, short type, int length, int *newlength, short *newtype, struct plot *pl, struct plot *newpl)
Definition: cmath4.c:263
double * v_realdata
Definition: ftedata.h:28
char * cx_not(char *data, short type, int length, int *newlength, short *newtype)
Definition: cmath4.c:122
#define VF_COMPLEX
Definition: fteconst.h:40
char * cx_interpolate(char *data, short type, int length, int *newlength, short *newtype, struct plot *pl, struct plot *newpl)
Definition: cmath4.c:164
char * kw_polydegree
Definition: options.c:404
char * cx_imag()
#define alloc_d(len)
Definition: ftecmath.h:12
#define realpart(cval)
Definition: cpstd.h:35