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_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_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);
}
}
/* 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);
}
main()
{
complex a, b, c, n[2];;
double real1, imag1, real2, imag2, d, e, f, g, mag, pha;
/*
a.real = 1.0; a.imag = 1.0;
b.real = 2.0; b.imag = 2.0;
*/
printf("\nEnter real part of first number = ");
scanf("%lf", &real1);
printf("\nEnter imaginary part of first number = ");
scanf("%lf", &imag1);
printf("\nEnter real part of second number = ");
scanf("%lf", &real2);
printf("\nEnter imaginary part of second number = ");
scanf("%lf", &imag2);
a.real = real1;
a.imag = imag1;
b.real = real2;
b.imag = imag2;
n[1].real = real1;
n[1].imag = imag1;
n[2].real = real2;
n[2].imag = imag2;
printf("a = "); print_complex(a); printf("\n");
printf("b = "); print_complex(b); printf("\n");
c = add(a,b);
printf("a + b = "); print_complex(c); printf("\n");
c = subtract(a,b);
printf("a - b = "); print_complex(c); printf("\n");
c = multiply(a,b);
printf("a * b = "); print_complex(c); printf("\n");
c = divide(a,b);
printf("a / b = "); print_complex(c); printf("\n");
d = realpart(a);
e = imaginarypart(a);
printf("real part of a = %lf\n", d);
printf("imaginary part of a = %lf\n", e);
f = realpart(b);
g = imaginarypart(b);
printf("real part of b = %lf\n", f);
printf("imaginary part of b = %lf\n", g);
mag = magnitude(a);
printf("magnitude of a = %lf\n", mag);
pha =phase(a);
printf("phase in radians of a = %lf\n", pha);
mag = magnitude(b);
printf("magnitude of b = %lf\n", mag);
pha = phase(b);
printf("phase in radians of b = %lf\n", pha);
}
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);
}
struct variable *
cp_enqvar(char *word)
{
struct dvec *d;
struct variable *vv, *tv;
struct plot *pl;
int i;
if (*word == '&') {
word++;
d = vec_get(word);
if (!d)
return (NULL);
if (d->v_length == 1) {
vv = alloc(struct variable);
vv->va_next = NULL;
vv->va_name = copy(word);
vv->va_type = CP_REAL;
if (isreal(d))
vv->va_real = d->v_realdata[0];
else
vv->va_real = realpart(d->v_compdata[0]);
} else {
double *
DBgetData(struct plot *plot, char *name, int lengthWanted)
{
struct dvec *v;
double *data;
int i;
v = vec_fromplot(name,plot);
if (!v) {
fprintf( stderr, "Error: cannot locate variable '%s'\n", name );
return(NULL);
}
if (v->v_length != lengthWanted ) {
fprintf( stderr, "Error: vector '%s' has incorrect length\n", name );
return(NULL);
}
data = TMALLOC(double, v->v_length);
if (isreal(v)) {
bcopy(v->v_realdata, data, sizeof (double) * (size_t) v->v_length);
} else {
for (i=0; i < v->v_length; i++) {
data[i] = realpart(v->v_compdata[i]);
}
}
return(data);
}
//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;
}
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);
}
void *
cx_atan(void *data, short int type, int length, int *newlength, short int *newtype, ...)
{
double *d;
d = alloc_d(length);
*newtype = VF_REAL;
*newlength = length;
if (type == VF_COMPLEX) {
complex *cc = (complex *) data;
int i;
for (i = 0; i < length; i++)
d[i] = radtodeg(atan(realpart(&cc[i])));
} else {
double *dd = (double *) data;
int i;
for (i = 0; i < length; i++)
d[i] = radtodeg(atan(dd[i]));
}
return ((void *) d);
}
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);
}
void
ft_xgraph(double *xlims, double *ylims, char *filename, char *title, char *xlabel, char *ylabel, GRIDTYPE gridtype, PLOTTYPE plottype, struct dvec *vecs)
{
FILE *file;
struct dvec *v, *scale;
double xval, yval;
int i, numVecs, linewidth;
bool xlog, ylog, nogrid, markers;
char buf[BSIZE_SP], pointstyle[BSIZE_SP], *text;
/* Sanity checking. */
for (v = vecs, numVecs = 0; v; v = v->v_link2)
numVecs++;
if (numVecs == 0) {
return;
} else if (numVecs > XG_MAXVECTORS) {
fprintf(cp_err, "Error: too many vectors for Xgraph.\n");
return;
}
if (!cp_getvar("xbrushwidth", CP_NUM, &linewidth))
linewidth = 1;
if (linewidth < 1)
linewidth = 1;
if (!cp_getvar("pointstyle", CP_STRING, pointstyle)) {
markers = FALSE;
} else {
if (cieq(pointstyle, "markers"))
markers = TRUE;
else
markers = FALSE;
}
/* Make sure the gridtype is supported. */
switch (gridtype) {
case GRID_LIN:
nogrid = xlog = ylog = FALSE;
break;
case GRID_XLOG:
xlog = TRUE;
nogrid = ylog = FALSE;
break;
case GRID_YLOG:
ylog = TRUE;
nogrid = xlog = FALSE;
break;
case GRID_LOGLOG:
xlog = ylog = TRUE;
nogrid = FALSE;
break;
case GRID_NONE:
nogrid = TRUE;
xlog = ylog = FALSE;
break;
default:
fprintf(cp_err, "Error: grid type unsupported by Xgraph.\n");
return;
}
/* Open the output file. */
if ((file = fopen(filename, "w")) == NULL) {
perror(filename);
return;
}
/* Set up the file header. */
if (title) {
text = cp_unquote(title);
fprintf(file, "TitleText: %s\n", text);
tfree(text);
}
if (xlabel) {
text = cp_unquote(xlabel);
fprintf(file, "XUnitText: %s\n", text);
tfree(text);
}
if (ylabel) {
text = cp_unquote(ylabel);
fprintf(file, "YUnitText: %s\n", text);
tfree(text);
}
if (nogrid) {
fprintf(file, "Ticks: True\n");
}
if (xlog) {
fprintf(file, "LogX: True\n");
if (xlims) {
fprintf(file, "XLowLimit: % e\n", log10(xlims[0]));
fprintf(file, "XHighLimit: % e\n", log10(xlims[1]));
}
} else {
if (xlims) {
fprintf(file, "XLowLimit: % e\n", xlims[0]);
fprintf(file, "XHighLimit: % e\n", xlims[1]);
}
}
if (ylog) {
fprintf(file, "LogY: True\n");
if (ylims) {
fprintf(file, "YLowLimit: % e\n", log10(ylims[0]));
fprintf(file, "YHighLimit: % e\n", log10(ylims[1]));
}
} else {
if (ylims) {
fprintf(file, "YLowLimit: % e\n", ylims[0]);
fprintf(file, "YHighLimit: % e\n", ylims[1]);
}
}
fprintf(file, "LineWidth: %d\n", linewidth);
fprintf(file, "BoundBox: True\n");
if (plottype == PLOT_COMB) {
fprintf(file, "BarGraph: True\n");
fprintf(file, "NoLines: True\n");
} else if (plottype == PLOT_POINT) {
if (markers)
fprintf(file, "Markers: True\n");
else
fprintf(file, "LargePixels: True\n");
fprintf(file, "NoLines: True\n");
}
/* Write out the data. */
for (v = vecs; v; v = v->v_link2) {
scale = v->v_scale;
if (v->v_name)
fprintf(file, "\"%s\"\n", v->v_name);
for (i = 0; i < scale->v_length; i++) {
xval = isreal(scale) ?
scale->v_realdata[i] : realpart(scale->v_compdata[i]);
yval = isreal(v) ?
v->v_realdata[i] : realpart(v->v_compdata[i]);
fprintf(file, "% e % e\n", xval, yval);
}
fprintf(file, "\n");
}
(void) fclose(file);
(void) sprintf(buf, "xgraph %s &", filename);
(void) system(buf);
}
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);
}
}
}
}
}
}
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);
}
