static complex *
c_tan(complex *cc, int length)
{
complex *c;
int i;
c = alloc_c(length);
for (i = 0; i < length; i++) {
double u, v;
rcheck(cos(degtorad(realpart(&cc[i]))) *
cosh(degtorad(imagpart(&cc[i]))), "tan");
rcheck(sin(degtorad(realpart(&cc[i]))) *
sinh(degtorad(imagpart(&cc[i]))), "tan");
u = degtorad(realpart(&cc[i]));
v = degtorad(imagpart(&cc[i]));
/* The Lattice C compiler won't take multi-line macros, and
* CMS won't take >80 column lines....
*/
#define xx1 sin(u) * cosh(v)
#define xx2 cos(u) * sinh(v)
#define xx3 cos(u) * cosh(v)
#define xx4 sin(u) * sinh(v)
cdiv(xx1, xx2, xx3, xx4, realpart(&c[i]), imagpart(&c[i]));
}
return c;
}
void *
cx_mean(void *data, short int type, int length, int *newlength, short int *newtype, ...)
{
*newlength = 1;
rcheck(length > 0, "mean");
if (type == VF_REAL) {
double *d;
double *dd = (double *) data;
int i;
d = alloc_d(1);
*newtype = VF_REAL;
for (i = 0; i < length; i++)
*d += dd[i];
*d /= length;
return ((void *) d);
} else {
complex *c;
complex *cc = (complex *) data;
int i;
c = alloc_c(1);
*newtype = VF_COMPLEX;
for (i = 0; i < length; i++) {
realpart(c) += realpart(cc + i);
imagpart(c) += imagpart(cc + i);
}
realpart(c) /= length;
imagpart(c) /= length;
return ((void *) c);
}
}
void *
cx_uminus(void *data, short int type, int length, int *newlength, short int *newtype, ...)
{
*newlength = length;
if (type == VF_COMPLEX) {
complex *c;
complex *cc = (complex *) data;
int i;
c = alloc_c(length);
*newtype = VF_COMPLEX;
for (i = 0; i < length; i++) {
realpart(&c[i]) = - realpart(&cc[i]);
imagpart(&c[i]) = - imagpart(&cc[i]);
}
return ((void *) c);
} else {
double *d;
double *dd = (double *) data;
int i;
d = alloc_d(length);
*newtype = VF_REAL;
for (i = 0; i < length; i++)
d[i] = - dd[i];
return ((void *) d);
}
}
void *
cx_mod(void *data1, void *data2, short int datatype1, short int datatype2, int length, ...)
{
double *dd1 = (double *) data1;
double *dd2 = (double *) data2;
double *d;
complex *cc1 = (complex *) data1;
complex *cc2 = (complex *) data2;
complex *c, c1, c2;
int i, r1, r2, i1, i2, r3, i3;
if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
d = alloc_d(length);
for (i = 0; i < length; i++) {
r1 = floor(FTEcabs(dd1[i]));
rcheck(r1 > 0, "mod");
r2 = floor(FTEcabs(dd2[i]));
rcheck(r2 > 0, "mod");
r3 = r1 % r2;
d[i] = (double) r3;
}
return ((void *) d);
} else {
c = alloc_c(length);
for (i = 0; i < length; i++) {
if (datatype1 == VF_REAL) {
realpart(&c1) = dd1[i];
imagpart(&c1) = 0.0;
} else {
realpart(&c1) = realpart(&cc1[i]);
imagpart(&c1) = imagpart(&cc1[i]);
}
if (datatype2 == VF_REAL) {
realpart(&c2) = dd2[i];
imagpart(&c2) = 0.0;
} else {
realpart(&c2) = realpart(&cc2[i]);
imagpart(&c2) = imagpart(&cc2[i]);
}
r1 = floor(FTEcabs(realpart(&c1)));
rcheck(r1 > 0, "mod");
r2 = floor(FTEcabs(realpart(&c2)));
rcheck(r2 > 0, "mod");
i1 = floor(FTEcabs(imagpart(&c1)));
rcheck(i1 > 0, "mod");
i2 = floor(FTEcabs(imagpart(&c2)));
rcheck(i2 > 0, "mod");
r3 = r1 % r2;
i3 = i1 % i2;
realpart(&c[i]) = (double) r3;
imagpart(&c[i]) = (double) i3;
}
return ((void *) c);
}
}
LOCAL struct bigblock *
putcxeq(struct bigblock *q)
{
struct bigblock *lp, *rp;
lp = putcx1(q->b_expr.leftp);
rp = putcx1(q->b_expr.rightp);
sendp2(putassign(realpart(lp), realpart(rp)));
if( ISCOMPLEX(q->vtype) ) {
sendp2(putassign(imagpart(lp), imagpart(rp)));
}
frexpr(rp);
ckfree(q);
return(lp);
}
//double *
//ft_SMITHminmax(struct dvec *v, bool yval)
double *
ft_SMITHminmax(struct dvec *v, int yval)
{
static double res[2];
register int i;
double d, d2;
res[0] = HUGE;
res[1] = - res[0];
for (i = 0; i < v->v_length; i++) {
if (isreal(v))
SMITH_tfm(v->v_realdata[i], 0.0, &d, &d2);
else
SMITH_tfm(realpart(v->v_compdata[i]), imagpart(v->v_compdata[i]),
&d, &d2);
/* Are we are looking for min/max X or Y ralue
*/
if (yval)
d = d2;
if (d < res[0])
res[0] = d;
if (d > res[1])
res[1] = d;
}
return (res);
}
Complex HighPrecisionComplexPolynom::evaluateAt(Complex z) {
cln::cl_N precZ = complex(cl_float(z.x,clnDIGIT), cl_float(z.y,clnDIGIT));
cln::cl_N precRes = evaluateAt(precZ);
Complex res(double_approx(realpart(precRes)), double_approx(imagpart(precRes)));
return res;
}
/* simple printout of data into a file, similar to data table in ft_gnuplot
command: wrsimple file vecs
*/
void
ft_writesimple(double *xlims, double *ylims, char *filename, char *title, char *xlabel, char *ylabel, GRIDTYPE gridtype, PLOTTYPE plottype, struct dvec *vecs)
{
FILE *file_data;
struct dvec *v, *scale = NULL;
double xval;
int i, numVecs;
bool appendwrite;
char filename_data[128];
NG_IGNORE(xlims);
NG_IGNORE(ylims);
NG_IGNORE(title);
NG_IGNORE(xlabel);
NG_IGNORE(ylabel);
NG_IGNORE(gridtype);
NG_IGNORE(plottype);
sprintf(filename_data, "%s.data", filename);
appendwrite = cp_getvar("appendwrite", CP_BOOL, NULL);
/* Sanity checking. */
for (v = vecs, numVecs = 0; v; v = v->v_link2)
numVecs++;
if (numVecs == 0)
return;
/* Open the output data file. */
if ((file_data = fopen(filename_data, appendwrite ? "a" : "w")) == NULL) {
perror(filename);
return;
}
i = 0;
for (v = vecs; v; v = v->v_link2)
scale = v->v_scale;
/* Write out the data as simple arrays */
for (i = 0; i < scale->v_length; i++) {
for (v = vecs; v; v = v->v_link2) {
scale = v->v_scale;
xval = isreal(scale) ?
scale->v_realdata[i] : realpart(scale->v_compdata[i]);
if (isreal(v))
fprintf(file_data, "% e % e ", xval, v->v_realdata[i]);
else
fprintf(file_data, "% e % e % e ", xval, realpart(v->v_compdata[i]), imagpart(v->v_compdata[i]));
}
fprintf(file_data, "\n");
}
(void) fclose(file_data);
}
int
main(void)
{
ngcomplex_t *c = NULL;
double *d = NULL;
short int t1;
short int t2;
int n1, n2;
double eps = DBL_EPSILON;
cp_err = stderr;
n1 = 9;
t1 = VF_COMPLEX;
c = alloc_c(n1);
realpart(c[0]) = 0.0;
imagpart(c[0]) = +1.0; /* i^1 */
realpart(c[1]) = -1.0;
imagpart(c[1]) = 0.0; /* i^2 */
realpart(c[2]) = 0.0;
imagpart(c[2]) = -1.0; /* i^3 */
realpart(c[3]) = +1.0;
imagpart(c[3]) = 0.0; /* i^4 */
realpart(c[4]) = 0.0;
imagpart(c[4]) = +1.0; /* i^5 */
realpart(c[5]) = +1.0;
imagpart(c[5]) = 0.0; /* i^4 */
realpart(c[6]) = 0.0;
imagpart(c[6]) = -1.0; /* i^3 */
realpart(c[7]) = -1.0;
imagpart(c[7]) = 0.0; /* i^2 */
realpart(c[8]) = 0.0;
imagpart(c[8]) = +1.0; /* i^1 */
d = (double *) cx_cph((void *) c, t1, n1, &n2, &t2);
if ( eq_p(1*M_PI/2, d[0], eps) &&
eq_p(2*M_PI/2, d[1], eps) &&
eq_p(3*M_PI/2, d[2], eps) &&
eq_p(4*M_PI/2, d[3], eps) &&
eq_p(5*M_PI/2, d[4], eps) &&
eq_p(4*M_PI/2, d[5], eps) &&
eq_p(3*M_PI/2, d[6], eps) &&
eq_p(2*M_PI/2, d[7], eps) &&
eq_p(1*M_PI/2, d[8], eps) )
return 0;
else
return 1;
}
Complex* HighPrecisionComplexPolynom::getRoots() {
if (getOrder()==0) return NULL;
cln::cl_N* precRoots = getPrecRoots();
Complex* roots = new Complex[getOrder()];
for (int I=0; I<getOrder(); I++) {
roots[I] = Complex(double_approx(realpart(precRoots[I])), double_approx(imagpart(precRoots[I])));
}
delete[] precRoots;
return roots;
}
void *
cx_min(void *data, short int type, int length, int *newlength, short int *newtype, ...)
{
*newlength = 1;
/* test if length >0 et affiche un message d'erreur */
rcheck(length > 0, "mean");
if (type == VF_REAL) {
double smallest;
double *d;
double *dd = (double *) data;
int i;
d = alloc_d(1);
*newtype = VF_REAL;
smallest=dd[0];
for (i = 1; i < length; i++)
if (dd[i]<smallest) smallest=dd[i];
*d=smallest;
return ((void *) d);
} else {
double smallest_real;
double smallest_complex;
complex *c;
complex *cc = (complex *) data;
int i;
c = alloc_c(1);
*newtype = VF_COMPLEX;
smallest_real=realpart(cc);
smallest_complex=imagpart(cc);
for (i = 1; i < length; i++) {
if (realpart(cc + i)<smallest_real) smallest_real=realpart(cc + i);
if (imagpart(cc + i)<smallest_complex) smallest_complex=imagpart(cc + i);
}
realpart(c) = smallest_real;
imagpart(c) = smallest_complex;
return ((void *) c);
}
}
LOCAL NODE *
putcxcmp(struct bigblock *p)
{
NODE *p1;
int opcode;
struct bigblock *lp, *rp;
struct bigblock *q;
opcode = p->b_expr.opcode;
lp = putcx1(p->b_expr.leftp);
rp = putcx1(p->b_expr.rightp);
q = mkexpr( opcode==OPEQ ? OPAND : OPOR ,
mkexpr(opcode, realpart(lp), realpart(rp)),
mkexpr(opcode, imagpart(lp), imagpart(rp)) );
p1 = putx( fixexpr(q) );
ckfree(lp);
ckfree(rp);
ckfree(p);
return p1;
}
void *
cx_norm(void *data, short int type, int length, int *newlength, short int *newtype, ...)
{
double largest = 0.0;
largest = cx_max_local(data, type, length);
if (largest == 0.0) {
fprintf(cp_err, "Error: can't normalize a 0 vector\n");
return (NULL);
}
*newlength = length;
if (type == VF_COMPLEX) {
complex *c;
complex *cc = (complex *) data;
int i;
c = alloc_c(length);
*newtype = VF_COMPLEX;
for (i = 0; i < length; i++) {
realpart(&c[i]) = realpart(&cc[i]) / largest;
imagpart(&c[i]) = imagpart(&cc[i]) / largest;
}
return ((void *) c);
} else {
double *d;
double *dd = (double *) data;
int i;
d = alloc_d(length);
*newtype = VF_REAL;
for (i = 0; i < length; i++)
d[i] = dd[i] / largest;
return ((void *) d);
}
}
void *
cx_rnd(void *data, short int type, int length, int *newlength, short int *newtype, ...)
{
*newlength = length;
if (type == VF_COMPLEX) {
complex *c;
complex *cc = (complex *) data;
int i;
c = alloc_c(length);
*newtype = VF_COMPLEX;
for (i = 0; i < length; i++) {
int j, k;
j = floor(realpart(&cc[i]));
k = floor(imagpart(&cc[i]));
realpart(&c[i]) = j ? random() % j : 0;
imagpart(&c[i]) = k ? random() % k : 0;
}
return ((void *) c);
} else {
double *d;
double *dd = (double *) data;
int i;
d = alloc_d(length);
*newtype = VF_REAL;
for (i = 0; i < length; i++) {
int j;
j = floor(dd[i]);
d[i] = j ? random() % j : 0;
}
return ((void *) d);
}
}
void *
cx_d(void *data, short int type, int length, int *newlength, short int *newtype, ...)
{
*newlength = length;
/* test if length >0 et affiche un message d'erreur */
rcheck(length > 0, "deriv");
if (type == VF_REAL) {
double *d;
double *dd = (double *) data;
int i;
d = alloc_d(length);
*newtype = VF_REAL;
d[0]=dd[1]-dd[0];
d[length-1]=dd[length-1]-dd[length-2];
for (i = 1; i < length-1; i++)
d[i]=dd[i+1]-dd[i-1];
return ((void *) d);
} else {
complex *c;
complex *cc = (complex *) data;
int i;
c = alloc_c(length);
*newtype = VF_COMPLEX;
realpart(c)=realpart(cc+1)-realpart(cc);
imagpart(c)=imagpart(cc+1)-imagpart(cc);
realpart(c+length-1)=realpart(cc+length-1)-realpart(cc+length-2);
imagpart(c+length-1)=imagpart(cc+length-1)-imagpart(cc+length-2);
for (i = 1; i < (length-1); i++) {
realpart(c+i)=realpart(cc+i+1)-realpart(cc+i-1);
imagpart(c+i)=imagpart(cc+i+1)-imagpart(cc+i-1);
}
return ((void *) c);
}
}
void *
cx_minus(void *data1, void *data2, short int datatype1, short int datatype2, int length, ...)
{
double *dd1 = (double *) data1;
double *dd2 = (double *) data2;
double *d;
complex *cc1 = (complex *) data1;
complex *cc2 = (complex *) data2;
complex *c, c1, c2;
int i;
if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
d = alloc_d(length);
for (i = 0; i < length; i++)
d[i] = dd1[i] - dd2[i];
return ((void *) d);
} else {
c = alloc_c(length);
for (i = 0; i < length; i++) {
if (datatype1 == VF_REAL) {
realpart(&c1) = dd1[i];
imagpart(&c1) = 0.0;
} else {
realpart(&c1) = realpart(&cc1[i]);
imagpart(&c1) = imagpart(&cc1[i]);
}
if (datatype2 == VF_REAL) {
realpart(&c2) = dd2[i];
imagpart(&c2) = 0.0;
} else {
realpart(&c2) = realpart(&cc2[i]);
imagpart(&c2) = imagpart(&cc2[i]);
}
realpart(&c[i]) = realpart(&c1) - realpart(&c2);
imagpart(&c[i]) = imagpart(&c1) - imagpart(&c2);
}
return ((void *) c);
}
}
bool
vec_iszero(struct dvec *v)
{
int i;
for (; v; v = v->v_link2)
if (isreal(v))
for (i = 0; i < v->v_length; i++) {
if (v->v_realdata[i] != 0.0)
return FALSE;
}
else
for (i = 0; i < v->v_length; i++) {
if (realpart(v->v_compdata[i]) != 0.0)
return FALSE;
if (imagpart(v->v_compdata[i]) != 0.0)
return FALSE;
}
return TRUE;
}
void *
cx_or(void *data1, void *data2, short int datatype1, short int datatype2, int length)
{
double *dd1 = (double *) data1;
double *dd2 = (double *) data2;
double *d;
complex *cc1 = (complex *) data1;
complex *cc2 = (complex *) data2;
complex c1, c2;
int i;
d = alloc_d(length);
if ((datatype1 == VF_REAL) && (datatype2 == VF_REAL)) {
for (i = 0; i < length; i++)
d[i] = dd1[i] || dd2[i];
} else {
for (i = 0; i < length; i++) {
if (datatype1 == VF_REAL) {
realpart(&c1) = dd1[i];
imagpart(&c1) = 0.0;
} else {
realpart(&c1) = realpart(&cc1[i]);
imagpart(&c1) = imagpart(&cc1[i]);
}
if (datatype2 == VF_REAL) {
realpart(&c2) = dd2[i];
imagpart(&c2) = 0.0;
} else {
realpart(&c2) = realpart(&cc2[i]);
imagpart(&c2) = imagpart(&cc2[i]);
}
d[i] = ((realpart(&c1) || realpart(&c2)) &&
(imagpart(&c1) || imagpart(&c2)));
}
}
return ((void *) d);
}
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);
}
int
main(void)
{
complex *c = NULL;
double *d = NULL;
short int t1;
short int t2;
int n1;
int n2;
double eps = DBL_EPSILON;
cp_err = stderr;
n1 = 1;
t1 = VF_COMPLEX;
c = alloc_c(n1);
realpart(&c[0]) = .0;
imagpart(&c[0]) = 1.0;
d = (double *) cx_ph((void *) c, t1, n1, &n2, &t2);
if (M_PI/2 - eps < d[0] && d[0] < M_PI/2 + eps)
return 0;
else
return 1;
}
void *
cx_not(void *data, short int type, int length, int *newlength, short int *newtype)
{
double *d;
double *dd = (double *) data;
complex *cc = (complex *) data;
int i;
d = alloc_d(length);
*newtype = VF_REAL;
*newlength = length;
if (type == VF_COMPLEX) {
for (i = 0; i < length; i++) {
/* gcc doens't like !double */
d[i] = realpart(&cc[i]) ? 0 : 1;
d[i] = imagpart(&cc[i]) ? 0 : 1;
}
} else {
for (i = 0; i < length; i++)
d[i] = ! dd[i];
}
return ((void *) d);
}
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);
}
//double *
//ft_minmax(struct dvec *v, bool real)
double *
ft_minmax(struct dvec *v, int real)
{
static double res[2];
register int i;
double d;
res[0] = HUGE;
res[1] = - res[0];
for (i = 0; i < v->v_length; i++) {
if (isreal(v))
d = v->v_realdata[i];
else if (real)
d = realpart(v->v_compdata[i]);
else
d = imagpart(v->v_compdata[i]);
if (d < res[0])
res[0] = d;
if (d > res[1])
res[1] = d;
}
return (res);
}
Complex HighPrecisionComplex::getComplex() {
Complex res(double_approx(realpart(z)), double_approx(imagpart(z)));
return res;
}
void
com_diff(wordlist *wl)
{
double vntol, abstol, reltol, tol, cmax, cm1, cm2;
struct plot *p1, *p2 = NULL;
struct dvec *v1, *v2;
double d1, d2;
ngcomplex_t c1, c2, c3;
int i, j;
char *v1_name; /* cannonical v1 name */
char *v2_name; /* cannonical v2 name */
NGHASHPTR crossref_p; /* cross reference hash table */
SPICE_DSTRING ibuf; /* used to build cannonical name */
wordlist *tw;
char numbuf[BSIZE_SP], numbuf2[BSIZE_SP], numbuf3[BSIZE_SP], numbuf4[BSIZE_SP]; /* For printnum */
if (!cp_getvar("diff_vntol", CP_REAL, &vntol))
vntol = 1.0e-6;
if (!cp_getvar("diff_abstol", CP_REAL, &abstol))
abstol = 1.0e-12;
if (!cp_getvar("diff_reltol", CP_REAL, &reltol))
reltol = 0.001;
/* Let's try to be clever about defaults. This code is ugly. */
if (!wl || !wl->wl_next) {
if (plot_list && plot_list->pl_next && !plot_list->pl_next->pl_next) {
p1 = plot_list;
p2 = plot_list->pl_next;
if (wl && !eq(wl->wl_word, p1->pl_typename) &&
!eq(wl->wl_word, p2->pl_typename)) {
fprintf(cp_err, "Error: no such plot \"%s\"\n",
wl->wl_word);
return;
}
fprintf(cp_err, "Plots are \"%s\" and \"%s\"\n",
plot_list->pl_typename,
plot_list->pl_next->pl_typename);
if (wl)
wl = NULL;
} else {
fprintf(cp_err, "Error: plot names not given.\n");
return;
}
} else {
for (p1 = plot_list; p1; p1 = p1->pl_next)
if (eq(wl->wl_word, p1->pl_typename))
break;
if (!p1) {
fprintf(cp_err, "Error: no such plot %s\n", wl->wl_word);
return;
}
wl = wl->wl_next;
}
if (!p2) {
for (p2 = plot_list; p2; p2 = p2->pl_next)
if (eq(wl->wl_word, p2->pl_typename))
break;
if (!p2) {
fprintf(cp_err, "Error: no such plot %s\n", wl->wl_word);
return;
}
wl = wl->wl_next;
}
/* Now do some tests to make sure these plots are really the
* same type, etc.
*/
if (!eq(p1->pl_name, p2->pl_name))
fprintf(cp_err,
"Warning: plots %s and %s seem to be of different types\n",
p1->pl_typename, p2->pl_typename);
if (!eq(p1->pl_title, p2->pl_title))
fprintf(cp_err,
"Warning: plots %s and %s seem to be from different circuits\n",
p1->pl_typename, p2->pl_typename);
/* This may not be the best way to do this. It wasn't :). The original
* was O(n2) - not good. Now use a hash table to reduce it to O(n). */
for (v1 = p1->pl_dvecs; v1; v1 = v1->v_next)
v1->v_link2 = NULL;
spice_dstring_init(&ibuf);
crossref_p = nghash_init(NGHASH_MIN_SIZE);
nghash_unique(crossref_p, FALSE);
for (v2 = p2->pl_dvecs; v2; v2 = v2->v_next) {
v2->v_link2 = NULL;
v2_name = cannonical_name(v2->v_name, &ibuf);
nghash_insert(crossref_p, v2_name, v2);
}
for (v1 = p1->pl_dvecs; v1; v1 = v1->v_next) {
v1_name = cannonical_name(v1->v_name, &ibuf);
for (v2 = nghash_find(crossref_p, v1_name);
v2;
v2 = nghash_find_again(crossref_p, v1_name))
{
if (!v2->v_link2 &&
((v1->v_flags & (VF_REAL | VF_COMPLEX)) ==
(v2->v_flags & (VF_REAL | VF_COMPLEX))) &&
(v1->v_type == v2->v_type))
{
v1->v_link2 = v2;
v2->v_link2 = v1;
break;
}
}
}
spice_dstring_free(&ibuf);
nghash_free(crossref_p, NULL, NULL);
for (v1 = p1->pl_dvecs; v1; v1 = v1->v_next)
if (!v1->v_link2)
fprintf(cp_err,
">>> %s vector %s in %s not in %s, or of wrong type\n",
isreal(v1) ? "real" : "complex",
v1->v_name, p1->pl_typename, p2->pl_typename);
for (v2 = p2->pl_dvecs; v2; v2 = v2->v_next)
if (!v2->v_link2)
fprintf(cp_err,
">>> %s vector %s in %s not in %s, or of wrong type\n",
isreal(v2) ? "real" : "complex",
v2->v_name, p2->pl_typename, p1->pl_typename);
/* Throw out the ones that aren't in the arg list */
if (wl && !eq(wl->wl_word, "all")) { /* Just in case */
for (v1 = p1->pl_dvecs; v1; v1 = v1->v_next)
if (v1->v_link2) {
for (tw = wl; tw; tw = tw->wl_next)
if (nameeq(v1->v_name, tw->wl_word))
break;
if (!tw)
v1->v_link2 = NULL;
}
for (v2 = p2->pl_dvecs; v2; v2 = v2->v_next)
if (v2->v_link2) {
for (tw = wl; tw; tw = tw->wl_next)
if (nameeq(v2->v_name, tw->wl_word))
break;
if (!tw)
v2->v_link2 = NULL;
}
}
/* Now we have all the vectors linked to their twins. Travel
* down each one and print values that differ enough.
*/
for (v1 = p1->pl_dvecs; v1; v1 = v1->v_next) {
if (!v1->v_link2)
continue;
v2 = v1->v_link2;
if (v1->v_type == SV_VOLTAGE)
tol = vntol;
else
tol = abstol;
j = MAX(v1->v_length, v2->v_length);
for (i = 0; i < j; i++) {
if (v1->v_length <= i) {
fprintf(cp_out,
">>> %s is %d long in %s and %d long in %s\n",
v1->v_name, v1->v_length,
p1->pl_typename, v2->v_length, p2->pl_typename);
break;
} else if (v2->v_length <= i) {
fprintf(cp_out,
">>> %s is %d long in %s and %d long in %s\n",
v2->v_name, v2->v_length,
p2->pl_typename, v1->v_length, p1->pl_typename);
break;
} else {
if (isreal(v1)) {
d1 = v1->v_realdata[i];
d2 = v2->v_realdata[i];
if (MAX(fabs(d1), fabs(d2)) * reltol +
tol < fabs(d1 - d2)) {
printnum(numbuf, d1);
fprintf(cp_out,
"%s.%s[%d] = %-15s ",
p1->pl_typename, v1->v_name, i, numbuf);
printnum(numbuf, d2);
fprintf(cp_out,
"%s.%s[%d] = %s\n",
p2->pl_typename, v2->v_name, i, numbuf);
}
} else {
c1 = v1->v_compdata[i];
c2 = v2->v_compdata[i];
realpart(c3) = realpart(c1) - realpart(c2);
imagpart(c3) = imagpart(c1) - imagpart(c2);
/* Stupid evil PC compilers */
cm1 = cmag(c1);
cm2 = cmag(c2);
cmax = MAX(cm1, cm2);
if (cmax * reltol + tol < cmag(c3)) {
printnum(numbuf, realpart(c1));
printnum(numbuf2, imagpart(c1));
printnum(numbuf3, realpart(c2));
printnum(numbuf4, imagpart(c2));
fprintf(cp_out,
"%s.%s[%d] = %-10s, %-10s %s.%s[%d] = %-10s, %s\n",
p1->pl_typename, v1->v_name, i,
numbuf,
numbuf2,
p2->pl_typename, v2->v_name, i,
numbuf3,
numbuf4);
}
}
}
}
}
}
//
// Find a root of a complex polynomial by Laguerre iteration.
//
// The polynomial is Poly
// The order is Maxpow
//
// The precision: Digit
cln::cl_N HighPrecisionComplexPolynom::Lasolv(cln::cl_N* Poly, int Maxpow, cln::cl_N root, int itemax) {
int pow, ite;
root = complex(ZERO,ZERO);
cln::cl_F angl, small = As(cln::cl_F)(expt(cln::cl_float(0.1,clnDIGIT),DIGIT/2));
cln::cl_N dif1[Maxpow], dif2[Maxpow-1];
cln::cl_N val0, val, val1, val2, denp, denm, las1, las2, sqrv;
// cln::cl_N root;
for(pow = 0; pow < Maxpow; pow++)
dif1[pow] = (pow+1)*Poly[pow+1];
for(pow = 0; pow < Maxpow-1; pow++)
dif2[pow] = (pow+1)*dif1[pow+1];
// The maximal allowed number of iterations is set here;
// this can be chosen larger, but 100 usually suffices
// root = As(cln::cl_N)(complex(ZERO,ZERO));
val0 = EvalPoly(Poly,Maxpow,root);
// Iteration
for(ite = 0; ite < itemax; ite++)
{
val = val0;
val1 = EvalPoly(dif1,Maxpow-1,root);
val2 = EvalPoly(dif2,Maxpow-2,root);
sqrv = (Maxpow-1)*((Maxpow-1)*val1*val1-Maxpow*val0*val2);
angl = HALF*cln::cl_float(phase(sqrv),clnDIGIT);
sqrv = sqrt(abs(sqrv))*complex(cos(angl),sin(angl));
denp = val1+sqrv;
denm = val1-sqrv;
if(denp == complex(ZERO,ZERO))
root = root-Maxpow*val0/denm;
else
{ if(denm == complex(ZERO,ZERO))
root = root-Maxpow*val0/denp;
else
{ las1 = -Maxpow*val0/denp;
las2 = -Maxpow*val0/denm;
if(realpart(las1*conjugate(las1)) <
realpart(las2*conjugate(las2)))
root = root+las1;
else
root = root+las2; } }
// Look whether the root is good enough
val0 = EvalPoly(Poly,Maxpow,root);
if(abs(val0) == ZERO || (abs(val0) < small) && abs(val0/val) > 0.7) {
if(LogLevel>4) {
printf("Laguerre iterations: %d\n", ite);
printf("root = %f +i* %f\n", double_approx(realpart(root)), double_approx(imagpart(root)));
printf("value at root: %f +i* %f\n", double_approx(realpart(val0)), double_approx(imagpart(val0)));
}
break;
}
}
if(ite >= itemax) {
printf("Laguerre iteration did not converge\n");
exit(5);
}
return root;
}
LOCAL struct bigblock *
putcx1(bigptr qq)
{
struct bigblock *q, *lp, *rp;
register struct bigblock *resp;
NODE *p;
int opcode;
int ltype, rtype;
ltype = rtype = 0; /* XXX gcc */
if(qq == NULL)
return(NULL);
switch(qq->tag) {
case TCONST:
if( ISCOMPLEX(qq->vtype) )
qq = putconst(qq);
return( qq );
case TADDR:
if( ! addressable(qq) ) {
resp = fmktemp(tyint, NULL);
p = putassign( cpexpr(resp), qq->b_addr.memoffset );
sendp2(p);
qq->b_addr.memoffset = resp;
}
return( qq );
case TEXPR:
if( ISCOMPLEX(qq->vtype) )
break;
resp = fmktemp(TYDREAL, NO);
p = putassign( cpexpr(resp), qq);
sendp2(p);
return(resp);
default:
fatal1("putcx1: bad tag %d", qq->tag);
}
opcode = qq->b_expr.opcode;
if(opcode==OPCALL || opcode==OPCCALL) {
q = putcall(qq);
sendp2(callval);
return(q);
} else if(opcode == OPASSIGN) {
return( putcxeq(qq) );
}
resp = fmktemp(qq->vtype, NULL);
if((lp = putcx1(qq->b_expr.leftp) ))
ltype = lp->vtype;
if((rp = putcx1(qq->b_expr.rightp) ))
rtype = rp->vtype;
switch(opcode) {
case OPCOMMA:
frexpr(resp);
resp = rp;
rp = NULL;
break;
case OPNEG:
p = putassign(realpart(resp),
mkexpr(OPNEG, realpart(lp), NULL));
sendp2(p);
p = putassign(imagpart(resp),
mkexpr(OPNEG, imagpart(lp), NULL));
sendp2(p);
break;
case OPPLUS:
case OPMINUS:
p = putassign( realpart(resp),
mkexpr(opcode, realpart(lp), realpart(rp) ));
sendp2(p);
if(rtype < TYCOMPLEX) {
p = putassign(imagpart(resp), imagpart(lp) );
} else if(ltype < TYCOMPLEX) {
if(opcode == OPPLUS)
p = putassign( imagpart(resp), imagpart(rp) );
else
p = putassign( imagpart(resp),
mkexpr(OPNEG, imagpart(rp), NULL) );
} else
p = putassign( imagpart(resp),
mkexpr(opcode, imagpart(lp), imagpart(rp) ));
sendp2(p);
break;
case OPSTAR:
if(ltype < TYCOMPLEX) {
if( ISINT(ltype) )
lp = intdouble(lp);
p = putassign( realpart(resp),
mkexpr(OPSTAR, cpexpr(lp), realpart(rp) ));
sendp2(p);
p = putassign( imagpart(resp),
mkexpr(OPSTAR, cpexpr(lp), imagpart(rp) ));
} else if(rtype < TYCOMPLEX) {
if( ISINT(rtype) )
rp = intdouble(rp);
p = putassign( realpart(resp),
mkexpr(OPSTAR, cpexpr(rp), realpart(lp) ));
sendp2(p);
p = putassign( imagpart(resp),
mkexpr(OPSTAR, cpexpr(rp), imagpart(lp) ));
} else {
p = putassign( realpart(resp), mkexpr(OPMINUS,
mkexpr(OPSTAR, realpart(lp), realpart(rp)),
mkexpr(OPSTAR, imagpart(lp), imagpart(rp)) ));
sendp2(p);
p = putassign( imagpart(resp), mkexpr(OPPLUS,
mkexpr(OPSTAR, realpart(lp), imagpart(rp)),
mkexpr(OPSTAR, imagpart(lp), realpart(rp)) ));
}
sendp2(p);
break;
case OPSLASH:
/* fixexpr has already replaced all divisions
* by a complex by a function call
*/
if( ISINT(rtype) )
rp = intdouble(rp);
p = putassign( realpart(resp),
mkexpr(OPSLASH, realpart(lp), cpexpr(rp)) );
sendp2(p);
p = putassign( imagpart(resp),
mkexpr(OPSLASH, imagpart(lp), cpexpr(rp)) );
sendp2(p);
break;
case OPCONV:
p = putassign( realpart(resp), realpart(lp) );
if( ISCOMPLEX(lp->vtype) )
q = imagpart(lp);
else if(rp != NULL)
q = realpart(rp);
else
q = mkrealcon(TYDREAL, 0.0);
sendp2(p);
p = putassign( imagpart(resp), q);
sendp2(p);
break;
default:
fatal1("putcx1 of invalid opcode %d", opcode);
}
frexpr(lp);
frexpr(rp);
ckfree(qq);
return(resp);
}
//
// Find the complex roots of a complex polynomial Poly
// The order is Maxpow
// The result will be in the array Root
//
void HighPrecisionComplexPolynom::Polyrootc(cln::cl_N* Poly, int Maxpow, cln::cl_N* Root) {
int ord, pow, fnd, pov, maxp;
cln::cl_N poly[1+Maxpow], polc[1+Maxpow], coef[1+Maxpow], coen[1+Maxpow];
// Put coefficients in an array
for(pow = 0; pow < Maxpow+1; pow++) {
poly[pow] = As(cln::cl_N)(Poly[pow]);
coef[pow] = As(cln::cl_N)(Poly[pow]);
}
for(pow = 0; pow < Maxpow+1; pow++) {
polc[pow] = As(cln::cl_N)(complex(ZERO,ZERO));
}
polc[0] = As(cln::cl_N)(complex(ONE,ZERO));
fnd = -1;
// Loop for finding all roots
for(ord = 0; ord < Maxpow; ord++) {
fnd++;
pov = Maxpow-fnd;
if(fnd < Maxpow) {
if(LogLevel>4) {
printf(" root number: %d\n",fnd+1);
}
if((ord%2 == 1) && (Maxpow%2 == 0) && (false)) {
Root[fnd] = As(cln::cl_N)(conjugate(Root[fnd-1]));
cln::cl_N val0 = EvalPoly(poly, Maxpow, Root[fnd]);
if(LogLevel>3) {
printf("root = %f +i*%f\n", double_approx(realpart(Root[fnd])), double_approx(imagpart(Root[fnd])));
printf("value at root: %f +i*%f\n", double_approx(realpart(val0)), double_approx(imagpart(val0)));
}
}
else {
Root[fnd] = Lasolv(poly,pov, complex(ONE,ONE), 150);
}
for(pow = Maxpow; pow > 0; pow--) {
polc[pow] = polc[pow-1]-Root[fnd]*polc[pow];
}
polc[0] = -Root[fnd]*polc[pow];
// Divide the polynomial by the root
maxp = Maxpow-fnd-1;
coen[maxp] = coef[maxp+1];
for(pow = maxp-1; pow > -1; pow--) {
coen[pow] = coef[pow+1]+Root[fnd]*coen[pow+1];
}
for(pow = 0; pow < maxp+1; pow++) {
coef[pow] = coen[pow];
poly[pow] = coef[pow];
}
}
else {
break;
}
}
// Compare input with product of root factors
for(pow = 0; pow < Maxpow+1; pow++) {
polc[pow] = Poly[pow]-poly[0]*polc[pow];
}
if(LogLevel>4) {
printf("control polynomial should be close to zero:\n");
for(pow = 0; pow < Maxpow+1; pow++) {
printf(" x^{%d}\n",pow);
printf("%1.15f +i*%1.15f\n",double_approx(realpart(polc[pow])), double_approx(imagpart(polc[pow])));
}
}
}
void
raw_write(char *name, struct plot *pl, bool app, bool binary)
{
FILE *fp;
bool realflag = TRUE, writedims;
bool raw_padding;
int length, numdims, dims[MAXDIMS];
int nvars, i, j, prec;
struct dvec *v, *lv;
wordlist *wl;
struct variable *vv;
double dd;
char buf[BSIZE_SP];
char *branch;
raw_padding = !cp_getvar("nopadding", CP_BOOL, NULL);
/* Why bother printing out an empty plot? */
if (!pl->pl_dvecs) {
fprintf(cp_err, "Error: plot is empty, nothing written.\n");
return;
}
if (raw_prec != -1)
prec = raw_prec;
else
prec = DEFPREC;
#if defined(__MINGW32__) || defined(_MSC_VER)
/* - Binary file binary write - hvogt 15.03.2000 ---------------------*/
if (binary) {
if ((fp = fopen(name, app ? "ab" : "wb")) == NULL) {
perror(name);
return;
}
fprintf(cp_out, "binary raw file\n");
} else {
if ((fp = fopen(name, app ? "a" : "w")) == NULL) {
perror(name);
return;
}
fprintf(cp_out, "ASCII raw file\n");
}
/* --------------------------------------------------------------------*/
#else
if (!(fp = fopen(name, app ? "a" : "w"))) {
perror(name);
return;
}
#endif
numdims = nvars = length = 0;
for (v = pl->pl_dvecs; v; v = v->v_next) {
if (iscomplex(v))
realflag = FALSE;
nvars++;
/* Find the length and dimensions of the longest vector
* in the plot.
* Be paranoid and assume somewhere we may have
* forgotten to set the dimensions of 1-D vectors.
*/
if (v->v_numdims <= 1) {
v->v_numdims = 1;
v->v_dims[0] = v->v_length;
}
if (v->v_length > length) {
length = v->v_length;
numdims = v->v_numdims;
for (j = 0; j < numdims; j++) {
dims[j] = v->v_dims[j];
}
}
}
fprintf(fp, "Title: %s\n", pl->pl_title);
fprintf(fp, "Date: %s\n", pl->pl_date);
fprintf(fp, "Plotname: %s\n", pl->pl_name);
fprintf(fp, "Flags: %s%s\n",
realflag ? "real" : "complex", raw_padding ? "" : " unpadded");
fprintf(fp, "No. Variables: %d\n", nvars);
fprintf(fp, "No. Points: %d\n", length);
if (numdims > 1) {
dimstring(dims, numdims, buf);
fprintf(fp, "Dimensions: %s\n", buf);
}
for (wl = pl->pl_commands; wl; wl = wl->wl_next)
fprintf(fp, "Command: %s\n", wl->wl_word);
for (vv = pl->pl_env; vv; vv = vv->va_next) {
wl = cp_varwl(vv);
if (vv->va_type == CP_BOOL) {
fprintf(fp, "Option: %s\n", vv->va_name);
} else {
fprintf(fp, "Option: %s = ", vv->va_name);
if (vv->va_type == CP_LIST)
fprintf(fp, "( ");
wl_print(wl, fp);
if (vv->va_type == CP_LIST)
fprintf(fp, " )");
(void) putc('\n', fp);
}
}
/* Before we write the stuff out, make sure that the scale is the first
* in the list.
*/
for (lv = NULL, v = pl->pl_dvecs; v != pl->pl_scale; v = v->v_next)
lv = v;
if (lv) {
lv->v_next = v->v_next;
v->v_next = pl->pl_dvecs;
pl->pl_dvecs = v;
}
fprintf(fp, "Variables:\n");
for (i = 0, v = pl->pl_dvecs; v; v = v->v_next) {
if (v->v_type == SV_CURRENT) {
branch = NULL;
if ((branch = strstr(v->v_name, "#branch")) != NULL) {
*branch = '\0';
}
fprintf(fp, "\t%d\ti(%s)\t%s", i++, v->v_name, ft_typenames(v->v_type));
if (branch != NULL) *branch = '#';
} else if (v->v_type == SV_VOLTAGE) {
fprintf(fp, "\t%d\t%s\t%s", i++, v->v_name, ft_typenames(v->v_type));
} else {
fprintf(fp, "\t%d\t%s\t%s", i++, v->v_name, ft_typenames(v->v_type));
}
if (v->v_flags & VF_MINGIVEN)
fprintf(fp, " min=%e", v->v_minsignal);
if (v->v_flags & VF_MAXGIVEN)
fprintf(fp, " max=%e", v->v_maxsignal);
if (v->v_defcolor)
fprintf(fp, " color=%s", v->v_defcolor);
if (v->v_gridtype)
fprintf(fp, " grid=%d", v->v_gridtype);
if (v->v_plottype)
fprintf(fp, " plot=%d", v->v_plottype);
/* Only write dims if they are different from default. */
writedims = FALSE;
if (v->v_numdims != numdims) {
writedims = TRUE;
} else {
for (j = 0; j < numdims; j++)
if (dims[j] != v->v_dims[j])
writedims = TRUE;
}
if (writedims) {
dimstring(v->v_dims, v->v_numdims, buf);
fprintf(fp, " dims=%s", buf);
}
(void) putc('\n', fp);
}
if (binary) {
fprintf(fp, "Binary:\n");
for (i = 0; i < length; i++) {
for (v = pl->pl_dvecs; v; v = v->v_next) {
/* Don't run off the end of this vector's data. */
if (i < v->v_length) {
if (realflag) {
dd = (isreal(v) ? v->v_realdata[i] :
realpart(v->v_compdata[i]));
(void) fwrite(&dd, sizeof(double), 1, fp);
} else if (isreal(v)) {
dd = v->v_realdata[i];
(void) fwrite(&dd, sizeof(double), 1, fp);
dd = 0.0;
(void) fwrite(&dd, sizeof(double), 1, fp);
} else {
dd = realpart(v->v_compdata[i]);
(void) fwrite(&dd, sizeof(double), 1, fp);
dd = imagpart(v->v_compdata[i]);
(void) fwrite(&dd, sizeof(double), 1, fp);
}
} else if (raw_padding) {
dd = 0.0;
if (realflag) {
(void) fwrite(&dd, sizeof(double), 1, fp);
} else {
(void) fwrite(&dd, sizeof(double), 1, fp);
(void) fwrite(&dd, sizeof(double), 1, fp);
}
}
}
}
} else {
fprintf(fp, "Values:\n");
for (i = 0; i < length; i++) {
fprintf(fp, " %d", i);
for (v = pl->pl_dvecs; v; v = v->v_next) {
if (i < v->v_length) {
if (realflag)
fprintf(fp, "\t%.*e\n", prec,
isreal(v) ? v->v_realdata[i] :
realpart(v->v_compdata[i]));
else if (isreal(v))
fprintf(fp, "\t%.*e,0.0\n", prec,
v->v_realdata[i]);
else
fprintf(fp, "\t%.*e,%.*e\n", prec,
realpart(v->v_compdata[i]),
prec,
imagpart(v->v_compdata[i]));
} else if (raw_padding) {
if (realflag)
fprintf(fp, "\t%.*e\n", prec, 0.0);
else
fprintf(fp, "\t%.*e,%.*e\n", prec, 0.0, prec, 0.0);
}
}
(void) putc('\n', fp);
}
}
(void) fclose(fp);
}
void HighPrecisionComplexPolynom::print() {
for (int I=0; I<length; I++) {
Complex res(double_approx(realpart(coeff[I])), double_approx(imagpart(coeff[I])));
res.print();
}
}