Jspice3
cmath3.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 complex *j_cexp(complex*);
26 static complex *cln(complex*);
27 static complex *ctimes(complex*,complex*);
28 #else
29 static complex *j_cexp();
30 static complex *cln();
31 static complex *ctimes();
32 #endif
33 
34 
35 char *
36 cx_divide(data1, data2, datatype1, datatype2, length)
37 
38 char *data1, *data2;
39 short datatype1, datatype2;
40 {
41  double *dd1 = (double *) data1;
42  double *dd2 = (double *) data2;
43  double *d;
44  complex *cc1 = (complex *) data1;
45  complex *cc2 = (complex *) data2;
46  complex *c, c1, c2;
47  int i;
48 
49  if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
50  d = alloc_d(length);
51  for (i = 0; i < length; i++) {
52  rcheck(dd2[i] != 0, "divide");
53  d[i] = dd1[i] / dd2[i];
54  }
55  return ((char *) d);
56  }
57  else {
58  c = alloc_c(length);
59  for (i = 0; i < length; i++) {
60  if (datatype1 == VF_REAL) {
61  realpart(&c1) = dd1[i];
62  imagpart(&c1) = 0.0;
63  } else {
64  realpart(&c1) = realpart(&cc1[i]);
65  imagpart(&c1) = imagpart(&cc1[i]);
66  }
67  if (datatype2 == VF_REAL) {
68  realpart(&c2) = dd2[i];
69  imagpart(&c2) = 0.0;
70  } else {
71  realpart(&c2) = realpart(&cc2[i]);
72  imagpart(&c2) = imagpart(&cc2[i]);
73  }
74  rcheck((realpart(&c2) != 0) || (imagpart(&c2) != 0), "divide");
75 #define xx5 realpart(&c1)
76 #define xx6 imagpart(&c1)
77 cdiv(xx5, xx6, realpart(&c2), imagpart(&c2), realpart(&c[i]), imagpart(&c[i]));
78  }
79  return ((char *) c);
80  }
81 }
82 
83 /* The comma operator. What this does (unless it is part of the argument
84  * list of a user-defined function) is arg1 + j(arg2).
85  */
86 
87 char *
88 cx_comma(data1, data2, datatype1, datatype2, length)
89 
90 char *data1, *data2;
91 short datatype1, datatype2;
92 {
93  double *dd1 = (double *) data1;
94  double *dd2 = (double *) data2;
95  complex *cc1 = (complex *) data1;
96  complex *cc2 = (complex *) data2;
97  complex *c, c1, c2;
98  int i;
99 
100  c = alloc_c(length);
101  for (i = 0; i < length; i++) {
102  if (datatype1 == VF_REAL) {
103  realpart(&c1) = dd1[i];
104  imagpart(&c1) = 0.0;
105  }
106  else {
107  realpart(&c1) = realpart(&cc1[i]);
108  imagpart(&c1) = imagpart(&cc1[i]);
109  }
110  if (datatype2 == VF_REAL) {
111  realpart(&c2) = dd2[i];
112  imagpart(&c2) = 0.0;
113  }
114  else {
115  realpart(&c2) = realpart(&cc2[i]);
116  imagpart(&c2) = imagpart(&cc2[i]);
117  }
118 
119  realpart(&c[i]) = realpart(&c1) + imagpart(&c2);
120  imagpart(&c[i]) = imagpart(&c1) + realpart(&c2);
121  }
122  return ((char *) c);
123 }
124 
125 
126 char *
127 cx_power(data1, data2, datatype1, datatype2, length)
128 
129 char *data1, *data2;
130 short datatype1, datatype2;
131 {
132  double *dd1 = (double *) data1;
133  double *dd2 = (double *) data2;
134  double *d;
135  complex *cc1 = (complex *) data1;
136  complex *cc2 = (complex *) data2;
137  complex *c, c1, c2, *t;
138  int i;
139 
140  if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
141  d = alloc_d(length);
142  for (i = 0; i < length; i++) {
143  rcheck((dd1[i] >= 0) || (floor(dd2[i]) == ceil(dd2[i])), "power");
144  d[i] = pow(dd1[i], dd2[i]);
145  }
146  return ((char *) d);
147  }
148  else {
149  c = alloc_c(length);
150  for (i = 0; i < length; i++) {
151  if (datatype1 == VF_REAL) {
152  realpart(&c1) = dd1[i];
153  imagpart(&c1) = 0.0;
154  }
155  else {
156  realpart(&c1) = realpart(&cc1[i]);
157  imagpart(&c1) = imagpart(&cc1[i]);
158  }
159  if (datatype2 == VF_REAL) {
160  realpart(&c2) = dd2[i];
161  imagpart(&c2) = 0.0;
162  }
163  else {
164  realpart(&c2) = realpart(&cc2[i]);
165  imagpart(&c2) = imagpart(&cc2[i]);
166  }
167 
168  if ((realpart(&c1) == 0.0) && (imagpart(&c1) == 0.0)) {
169  realpart(&c[i]) = 0.0;
170  imagpart(&c[i]) = 0.0;
171  }
172  else { /* if ((imagpart(&c1) != 0.0) &&
173  (imagpart(&c2) != 0.0)) */
174  t = j_cexp(ctimes(&c2, cln(&c1)));
175  realpart(&c[i]) = realpart(t);
176  imagpart(&c[i]) = imagpart(t);
177  /*
178  }
179  else {
180  realpart(&c[i]) = pow(realpart(&c1),
181  realpart(&c2));
182  imagpart(&c[i]) = 0.0;
183  */
184  }
185  }
186  return ((char *) c);
187  }
188 }
189 
190 /* These are unnecessary... Only cx_power uses them... */
191 
192 static complex *
194 
195 complex *c;
196 {
197  static complex r;
198  double d;
199 
200  d = exp(realpart(c));
201  realpart(&r) = d * cos(imagpart(c));
202  if (imagpart(c) != 0.0)
203  imagpart(&r) = d * sin(imagpart(c));
204  else
205  imagpart(&r) = 0.0;
206  return (&r);
207 }
208 
209 
210 static complex *
212 
213 complex *c;
214 {
215  static complex r;
216 
217  rcheck(cmag(c) != 0, "ln");
218  realpart(&r) = log(cmag(c));
219  if (imagpart(c) != 0.0)
220  imagpart(&r) = atan2(imagpart(c), realpart(c));
221  else
222  imagpart(&r) = 0.0;
223  return (&r);
224 }
225 
226 
227 static complex *
228 ctimes(c1, c2)
229 
230 complex *c1, *c2;
231 {
232  static complex r;
233 
234  realpart(&r) = realpart(c1) * realpart(c2) -
235  imagpart(c1) * imagpart(c2);
236  imagpart(&r) = imagpart(c1) * realpart(c2) +
237  realpart(c1) * imagpart(c2);
238  return (&r);
239 }
240 
241 #ifdef HAVE_SHORTMACRO
242 
243 /* Some compilers get blown away by complicated macros */
244 
245 void
246 cx_cdiv(r1, i1, r2, i2, r3, i3)
247 
248 double r1, i1, r2, i2, *r3, *i3;
249 {
250  double r, s;
251 
252  if (FTEcabs(r2) > FTEcabs(i2)) {
253  r = i2 / r2;
254  s = r2 + r * i2;
255  if (!s) {
256  fprintf(cp_err, "Error: divide by 0\n");
257  return;
258  }
259  *r3 = (r1 + r * i1) / s;
260  *i3 = (i1 - r * r1) / s;
261  }else {
262  r = r2 / i2;
263  s = i2 + r * r2;
264  if (!s) {
265  fprintf(cp_err, "Error: divide by 0\n");
266  return;
267  }
268  *r3 = (r * r1 + i1) / s;
269  *i3 = (r * i1 - r1) / s;
270  }
271  return;
272 }
273 
274 #endif
275 
276 /* Now come all the relational and logical functions. It's overkill to put
277  * them here, but... Note that they always return a real value, with the
278  * result the same length as the arguments.
279  */
280 
281 char *
282 cx_eq(data1, data2, datatype1, datatype2, length)
283 
284 char *data1, *data2;
285 short datatype1, datatype2;
286 {
287  double *dd1 = (double *) data1;
288  double *dd2 = (double *) data2;
289  double *d;
290  complex *cc1 = (complex *) data1;
291  complex *cc2 = (complex *) data2;
292  complex c1, c2;
293  int i;
294 
295  d = alloc_d(length);
296  if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
297  for (i = 0; i < length; i++)
298  if (dd1[i] == dd2[i])
299  d[i] = 1.0;
300  else
301  d[i] = 0.0;
302  }
303  else {
304  for (i = 0; i < length; i++) {
305  if (datatype1 == VF_REAL) {
306  realpart(&c1) = dd1[i];
307  imagpart(&c1) = 0.0;
308  }
309  else {
310  realpart(&c1) = realpart(&cc1[i]);
311  imagpart(&c1) = imagpart(&cc1[i]);
312  }
313  if (datatype2 == VF_REAL) {
314  realpart(&c2) = dd2[i];
315  imagpart(&c2) = 0.0;
316  }
317  else {
318  realpart(&c2) = realpart(&cc2[i]);
319  imagpart(&c2) = imagpart(&cc2[i]);
320  }
321  d[i] = ((realpart(&c1) == realpart(&c2)) &&
322  (imagpart(&c1) == imagpart(&c2)));
323  }
324  }
325  return ((char *) d);
326 }
327 
328 
329 char *
330 cx_gt(data1, data2, datatype1, datatype2, length)
331 
332 char *data1, *data2;
333 short datatype1, datatype2;
334 {
335  double *dd1 = (double *) data1;
336  double *dd2 = (double *) data2;
337  double *d;
338  complex *cc1 = (complex *) data1;
339  complex *cc2 = (complex *) data2;
340  complex c1, c2;
341  int i;
342 
343  d = alloc_d(length);
344  if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
345  for (i = 0; i < length; i++)
346  if (dd1[i] > dd2[i])
347  d[i] = 1.0;
348  else
349  d[i] = 0.0;
350  }
351  else {
352  for (i = 0; i < length; i++) {
353  if (datatype1 == VF_REAL) {
354  realpart(&c1) = dd1[i];
355  imagpart(&c1) = 0.0;
356  }
357  else {
358  realpart(&c1) = realpart(&cc1[i]);
359  imagpart(&c1) = imagpart(&cc1[i]);
360  }
361  if (datatype2 == VF_REAL) {
362  realpart(&c2) = dd2[i];
363  imagpart(&c2) = 0.0;
364  }
365  else {
366  realpart(&c2) = realpart(&cc2[i]);
367  imagpart(&c2) = imagpart(&cc2[i]);
368  }
369  d[i] = ((realpart(&c1) > realpart(&c2)) &&
370  (imagpart(&c1) > imagpart(&c2)));
371  }
372  }
373  return ((char *) d);
374 }
375 
376 
377 char *
378 cx_lt(data1, data2, datatype1, datatype2, length)
379 
380 char *data1, *data2;
381 short datatype1, datatype2;
382 {
383  double *dd1 = (double *) data1;
384  double *dd2 = (double *) data2;
385  double *d;
386  complex *cc1 = (complex *) data1;
387  complex *cc2 = (complex *) data2;
388  complex c1, c2;
389  int i;
390 
391  d = alloc_d(length);
392  if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
393  for (i = 0; i < length; i++)
394  if (dd1[i] < dd2[i])
395  d[i] = 1.0;
396  else
397  d[i] = 0.0;
398  }
399  else {
400  for (i = 0; i < length; i++) {
401  if (datatype1 == VF_REAL) {
402  realpart(&c1) = dd1[i];
403  imagpart(&c1) = 0.0;
404  }
405  else {
406  realpart(&c1) = realpart(&cc1[i]);
407  imagpart(&c1) = imagpart(&cc1[i]);
408  }
409  if (datatype2 == VF_REAL) {
410  realpart(&c2) = dd2[i];
411  imagpart(&c2) = 0.0;
412  }
413  else {
414  realpart(&c2) = realpart(&cc2[i]);
415  imagpart(&c2) = imagpart(&cc2[i]);
416  }
417  d[i] = ((realpart(&c1) < realpart(&c2)) &&
418  (imagpart(&c1) < imagpart(&c2)));
419  }
420  }
421  return ((char *) d);
422 }
423 
424 
425 char *
426 cx_ge(data1, data2, datatype1, datatype2, length)
427 
428 char *data1, *data2;
429 short datatype1, datatype2;
430 {
431  double *dd1 = (double *) data1;
432  double *dd2 = (double *) data2;
433  double *d;
434  complex *cc1 = (complex *) data1;
435  complex *cc2 = (complex *) data2;
436  complex c1, c2;
437  int i;
438 
439  d = alloc_d(length);
440  if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
441  for (i = 0; i < length; i++)
442  if (dd1[i] >= dd2[i])
443  d[i] = 1.0;
444  else
445  d[i] = 0.0;
446  }
447  else {
448  for (i = 0; i < length; i++) {
449  if (datatype1 == VF_REAL) {
450  realpart(&c1) = dd1[i];
451  imagpart(&c1) = 0.0;
452  }
453  else {
454  realpart(&c1) = realpart(&cc1[i]);
455  imagpart(&c1) = imagpart(&cc1[i]);
456  }
457  if (datatype2 == VF_REAL) {
458  realpart(&c2) = dd2[i];
459  imagpart(&c2) = 0.0;
460  }
461  else {
462  realpart(&c2) = realpart(&cc2[i]);
463  imagpart(&c2) = imagpart(&cc2[i]);
464  }
465  d[i] = ((realpart(&c1) >= realpart(&c2)) &&
466  (imagpart(&c1) >= imagpart(&c2)));
467  }
468  }
469  return ((char *) d);
470 }
471 
472 
473 char *
474 cx_le(data1, data2, datatype1, datatype2, length)
475 
476 char *data1, *data2;
477 short datatype1, datatype2;
478 {
479  double *dd1 = (double *) data1;
480  double *dd2 = (double *) data2;
481  double *d;
482  complex *cc1 = (complex *) data1;
483  complex *cc2 = (complex *) data2;
484  complex c1, c2;
485  int i;
486 
487  d = alloc_d(length);
488  if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
489  for (i = 0; i < length; i++)
490  if (dd1[i] <= dd2[i])
491  d[i] = 1.0;
492  else
493  d[i] = 0.0;
494  }
495  else {
496  for (i = 0; i < length; i++) {
497  if (datatype1 == VF_REAL) {
498  realpart(&c1) = dd1[i];
499  imagpart(&c1) = 0.0;
500  } else {
501  realpart(&c1) = realpart(&cc1[i]);
502  imagpart(&c1) = imagpart(&cc1[i]);
503  }
504  if (datatype2 == VF_REAL) {
505  realpart(&c2) = dd2[i];
506  imagpart(&c2) = 0.0;
507  } else {
508  realpart(&c2) = realpart(&cc2[i]);
509  imagpart(&c2) = imagpart(&cc2[i]);
510  }
511  d[i] = ((realpart(&c1) <= realpart(&c2)) &&
512  (imagpart(&c1) <= imagpart(&c2)));
513  }
514  }
515  return ((char *) d);
516 }
517 
518 
519 char *
520 cx_ne(data1, data2, datatype1, datatype2, length)
521 
522 char *data1, *data2;
523 short datatype1, datatype2;
524 {
525  double *dd1 = (double *) data1;
526  double *dd2 = (double *) data2;
527  double *d;
528  complex *cc1 = (complex *) data1;
529  complex *cc2 = (complex *) data2;
530  complex c1, c2;
531  int i;
532 
533  d = alloc_d(length);
534  if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
535  for (i = 0; i < length; i++)
536  if (dd1[i] != dd2[i])
537  d[i] = 1.0;
538  else
539  d[i] = 0.0;
540  }
541  else {
542  for (i = 0; i < length; i++) {
543  if (datatype1 == VF_REAL) {
544  realpart(&c1) = dd1[i];
545  imagpart(&c1) = 0.0;
546  }
547  else {
548  realpart(&c1) = realpart(&cc1[i]);
549  imagpart(&c1) = imagpart(&cc1[i]);
550  }
551  if (datatype2 == VF_REAL) {
552  realpart(&c2) = dd2[i];
553  imagpart(&c2) = 0.0;
554  }
555  else {
556  realpart(&c2) = realpart(&cc2[i]);
557  imagpart(&c2) = imagpart(&cc2[i]);
558  }
559  d[i] = ((realpart(&c1) != realpart(&c2)) &&
560  (imagpart(&c1) != imagpart(&c2)));
561  }
562  }
563  return ((char *) d);
564 }
565 
static complex * cln()
#define VF_REAL
Definition: fteconst.h:39
char * cx_comma(char *data1, char *data2, short datatype1, short datatype2, length)
Definition: cmath3.c:88
#define xx5
Definition: cddefs.h:119
#define alloc_c(len)
Definition: ftecmath.h:11
char * cx_le(char *data1, char *data2, short datatype1, short datatype2, length)
Definition: cmath3.c:474
char * cx_gt(char *data1, char *data2, short datatype1, short datatype2, length)
Definition: cmath3.c:330
Definition: cpstd.h:29
char * cx_divide(char *data1, char *data2, short datatype1, short datatype2, length)
Definition: cmath3.c:36
#define cdiv(r1, i1, r2, i2, r3, i3)
Definition: ftecmath.h:25
char * cx_ge(char *data1, char *data2, short datatype1, short datatype2, length)
Definition: cmath3.c:426
FILE * cp_err
Definition: help.c:101
char * cx_eq(char *data1, char *data2, short datatype1, short datatype2, length)
Definition: cmath3.c:282
static complex * ctimes()
Definition: cddefs.h:237
char * cx_lt(char *data1, char *data2, short datatype1, short datatype2, length)
Definition: cmath3.c:378
double cos()
char * cx_ne(char *data1, char *data2, short datatype1, short datatype2, length)
Definition: cmath3.c:520
#define rcheck(cond, name)
Definition: ftecmath.h:18
static double c
Definition: vectors.c:16
double sin()
#define cmag(c)
Definition: ftecmath.h:15
#define imagpart(cval)
Definition: cpstd.h:36
#define xx6
Definition: cddefs.h:177
Definition: cddefs.h:162
#define FTEcabs(d)
Definition: ftecmath.h:13
static complex * j_cexp()
Definition: cddefs.h:192
#define alloc_d(len)
Definition: ftecmath.h:12
#define realpart(cval)
Definition: cpstd.h:35
char * cx_power(char *data1, char *data2, short datatype1, short datatype2, length)
Definition: cmath3.c:127