void polymult (header *hd)
{ header *st=hd,*hd1,*result;
int c,c1,c2,i,r,j,k;
double *m1,*m2,*mr,x;
complex *mc1,*mc2,*mcr,xc,hc;
interval *mi1,*mi2,*mir,xi,hi;
hd1=next_param(st);
equal_params_2(&hd,&hd1); if (error) return;
getmatrix(hd,&r,&c1,&m1); if (r!=1) wrong_arg();
getmatrix(hd1,&r,&c2,&m2); if (r!=1) wrong_arg();
if ((LONG)c1+c2-1>INT_MAX) wrong_arg();
c=c1+c2-1;
if (iscomplex(hd))
{ mc1=(complex *)m1; mc2=(complex *)m2;
result=new_cmatrix(1,c,""); if (error) return;
mcr=(complex *)matrixof(result);
c_copy(xc,*mc1); mc1++;
for (i=0; i<c2; i++) c_mult(xc,mc2[i],mcr[i]);
for (j=1; j<c1; j++)
{ c_copy(xc,*mc1); mc1++;
for (k=j,i=0; i<c2-1; i++,k++)
{ c_mult(xc,mc2[i],hc);
c_add(hc,mcr[k],mcr[k]);
}
c_mult(xc,mc2[i],mcr[k]);
}
}
else if (isinterval(hd))
{ mi1=(interval *)m1; mi2=(interval *)m2;
result=new_imatrix(1,c,""); if (error) return;
mir=(interval *)matrixof(result);
i_copy(xi,*mi1); mi1++;
for (i=0; i<c2; i++) i_mult(xi,mi2[i],mir[i]);
for (j=1; j<c1; j++)
{ i_copy(xi,*mi1); mi1++;
for (k=j,i=0; i<c2-1; i++,k++)
{ i_mult(xi,mi2[i],hi);
c_add(hi,mir[k],mir[k]);
}
c_mult(xi,mi2[i],mir[k]);
}
}
else if (isreal(hd))
{ result=new_matrix(1,c,""); if (error) return;
mr=matrixof(result);
x=*m1++;
for (i=0; i<c2; i++) mr[i]=x*m2[i];
for (j=1; j<c1; j++)
{ x=*m1++;
for (k=j,i=0; i<c2-1; i++,k++) mr[k]+=x*m2[i];
mr[k]=x*m2[i];
}
}
else wrong_arg();
moveresult(st,result);
}
void polyadd (header *hd)
{ header *st=hd,*hd1,*result;
int c,c1,c2,i,r;
double *m1,*m2,*mr;
complex *mc1,*mc2,*mcr;
interval *mi1,*mi2,*mir;
hd1=next_param(st);
equal_params_2(&hd,&hd1); if (error) return;
getmatrix(hd,&r,&c1,&m1); if (r!=1) wrong_arg();
getmatrix(hd1,&r,&c2,&m2); if (r!=1) wrong_arg();
c=max(c1,c2);
if (iscomplex(hd)) /* complex values */
{ mc1=(complex *)m1; mc2=(complex *)m2;
result=new_cmatrix(1,c,""); if (error) return;
mcr=(complex *)matrixof(result);
for (i=0; i<c; i++)
{ if (i>=c1) { c_copy(*mcr,*mc2); mcr++; mc2++; }
else if (i>=c2) { c_copy(*mcr,*mc1); mcr++; mc1++; }
else { c_add(*mc1,*mc2,*mcr); mc1++; mc2++; mcr++; }
}
}
else if (isinterval(hd))
{ mi1=(interval *)m1; mi2=(interval *)m2;
result=new_imatrix(1,c,""); if (error) return;
mir=(interval *)matrixof(result);
for (i=0; i<c; i++)
{ if (i>=c1) { i_copy(*mir,*mi2); mir++; mi2++; }
else if (i>=c2) { i_copy(*mir,*mi1); mir++; mi1++; }
else { i_add(*mi1,*mi2,*mir); mi1++; mi2++; mir++; }
}
}
else if (isreal(hd))
{ result=new_matrix(1,c,""); if (error) return;
mr=matrixof(result);
for (i=0; i<c; i++)
{ if (i>=c1) { *mr++ = *m2++; }
else if (i>=c2) { *mr++ = *m1++; }
else { *mr++ = *m1++ + *m2++; }
}
}
else wrong_arg();
moveresult(st,result);
}
/*
* NAME: data->assign_var()
* DESCRIPTION: assign a value to a variable
*/
void d_assign_var(dataspace *data, value *var, value *val)
{
if (var >= data->variables && var < data->variables + data->nvariables) {
if (data->plane->level != 0 &&
data->plane->original == (value *) NULL) {
/*
* back up variables
*/
i_copy(data->plane->original = ALLOC(value, data->nvariables),
data->variables, data->nvariables);
}
ref_rhs(data, val);
del_lhs(data, var);
data->plane->flags |= MOD_VARIABLE;
}
i_ref_value(val);
i_del_value(var);
*var = *val;
var->modified = TRUE;
}
void polydiv (header *hd)
{ header *st=hd,*hd1,*result,*rest;
int c1,c2,i,r,j;
double *m1,*m2,*mr,*mh,x,l;
complex *mc1,*mc2,*mcr,*mch,xc,lc,hc;
interval *mi1,*mi2,*mir,*mih,xi,li,hi;
hd1=next_param(st);
equal_params_2(&hd,&hd1); if (error) return;
getmatrix(hd,&r,&c1,&m1); if (r!=1) wrong_arg();
getmatrix(hd1,&r,&c2,&m2); if (r!=1) wrong_arg();
if (c1<c2)
{ result=new_real(0.0,"");
rest=(header *)newram;
moveresult(rest,hd1);
}
else if (iscomplex(hd))
{ mc1=(complex *)m1; mc2=(complex *)m2;
result=new_cmatrix(1,c1-c2+1,""); if (error) return;
mcr=(complex *)matrixof(result);
rest=new_cmatrix(1,c2,""); if (error) return;
mch=(complex *)newram;
if (!freeram(c1*sizeof(complex)))
{ output("Out of memory!\n"); error=190; return;
}
memmove((char *)mch,(char *)mc1,c1*sizeof(complex));
c_copy(lc,mc2[c2-1]);
if (lc[0]==0.0 && lc[1]==0.0) wrong_arg();
for (i=c1-c2; i>=0; i--)
{ c_div(mch[c2+i-1],lc,xc); c_copy(mcr[i],xc);
for(j=0; j<c2; j++)
{ c_mult(mc2[j],xc,hc);
c_sub(mch[i+j],hc,mch[i+j]);
}
}
memmove((char *)matrixof(rest),(char *)mch,c2*sizeof(complex));
}
else if (isinterval(hd))
{ mi1=(interval *)m1; mi2=(interval *)m2;
result=new_imatrix(1,c1-c2+1,""); if (error) return;
mir=(interval *)matrixof(result);
rest=new_imatrix(1,c2,""); if (error) return;
mih=(complex *)newram;
if (!freeram(c1*sizeof(complex)))
{ output("Out of memory!\n"); error=190; return;
}
memmove((char *)mih,(char *)mi1,c1*sizeof(interval));
i_copy(li,mi2[c2-1]);
if (li[0]<=0.0 && li[1]>=0.0) wrong_arg();
for (i=c1-c2; i>=0; i--)
{ i_div(mih[c2+i-1],li,xi); c_copy(mir[i],xi);
for(j=0; j<c2; j++)
{ i_mult(mi2[j],xi,hi);
i_sub(mih[i+j],hi,mih[i+j]);
}
}
memmove((char *)matrixof(rest),(char *)mih,c2*sizeof(interval));
}
else if (isreal(hd))
{ result=new_matrix(1,c1-c2+1,""); if (error) return;
mr=matrixof(result);
rest=new_matrix(1,c2,""); if (error) return;
mh=(double *)newram;
if (!freeram(c1*sizeof(double)))
{ output("Out of memory!\n"); error=190; return;
}
memmove((char *)mh,(char *)m1,c1*sizeof(double));
l=m2[c2-1];
if (l==0.0) wrong_arg();
for (i=c1-c2; i>=0; i--)
{ x=mh[c2+i-1]/l; mr[i]=x;
for(j=0; j<c2; j++) mh[i+j]-=m2[j]*x;
}
memmove((char *)matrixof(rest),(char *)mh,c2*sizeof(double));
}
else wrong_arg();
moveresult(st,result);
moveresult(nextof(st),rest);
}
