passagemath-singular 10.6.31rc3__cp314-cp314-manylinux_2_27_aarch64.manylinux_2_28_aarch64.whl

sage_wheels/share/singular/LIB/finitediff.lib

@@ -0,0 +1,1768 @@
+/////////////////////////////////////////////////////////////////////////////
+version="version finitediff.lib 4.1.2.0 Feb_2019 "; // $Id: 9fc46c5f49d8cc06120953f1d4f651b280512da8 $
+category="Teaching";
+info="
+LIBRARY:  finitediff.lib   procedures to compute finite difference schemes
+                           for linear differential equations
+AUTHOR:                    Christian Dingler
+
+OVERVIEW:
+@texinfo
+ Using @code{qepcad}/@code{qepcadsystem} from this
+ library requires the program @code{qepcad} to be installed.
+ You can download @code{qepcad} from
+ @uref{http://www.usna.edu/CS/qepcadweb/B/QEPCAD.html}
+ @end texinfo
+
+PROCEDURES:
+ visualize(f);            shows a scheme in index-notation
+ u(D[,#]);                gives some vector; depends on @derivatives
+ scheme([v1,..,vn]);      computes the finite difference scheme defined by v1,..,vn
+ laxfrT(Ut,U,space);      Lax-Friedrich-approximation for the time-direction
+ laxfrX(Ux,U,space);      Lax-Friedrich-approximation for the space-direction
+ forward(U1,U2,VAR);      forward-approximation
+ backward(U1,U2,VAR);     backward-approximation
+ central1st(U1,U2,VAR);   central-approximation of first order
+ central2nd(U1,U2,VAR);   central-approximation of second order
+ trapezoid(U1,U2,VAR);    trapezoid-approximation
+ midpoint(U1,U2,VAR);     midpoint-approximation
+ pyramid(U1,U2,VAR);      pyramid-approximation
+ setinitials(variable,der[,#]);    constructs and sets the basering for further computations
+ errormap(f);        performs the Fouriertransformation of a poly
+ matrixsystem(M,A);    gives the scheme of a pde-system as one matrix
+ timestep(M);        gives the several timelevels of a scheme derived from a pde-system
+ fouriersystem(M,A);  performs the Fouriertransformation of a matrix scheme
+ PartitionVar(f,n);      partitions a poly into the var(n)-part and the rest
+ ComplexValue(f);        computes the complex value of f, var(1) being the imaginary unit
+ VarToPar(f);            substitute var(i) by par(i)
+ ParToVar(f);            substitute par(i) by var(i)
+ qepcad(f);              ask QEPCAD for equivalent constraints to f<1
+ qepcadsystem(l);        ask QEPCAD for equivalent constraints to all eigenvals of some matrices being <1
+";
+
+LIB "ring.lib";
+LIB "general.lib";
+LIB "standard.lib";
+LIB "linalg.lib";
+LIB "matrix.lib";
+LIB "polylib.lib";
+LIB "teachstd.lib";
+LIB "qhmoduli.lib";
+///////////////////////////////////////////////////////////////////////
+static proc getit(module M)
+{
+  int nderiv=pos(U,@derivatives);
+  def M2=groebner(M);
+  module N1=gen(nderiv);
+  def N2=intersect(M2,N1);
+  def S=N2[1][nderiv];
+  return(S);
+}
+///////////////////////////////////////////////////////////////////////
+proc visualize(poly f)
+"USAGE:   visualize(f); f of type poly.
+RETURN:  type string; translates the polynomial form of a finite difference scheme into an indexed one as often seen in literature
+EXAMPLE: example visualize; shows an example
+"
+{
+  def n=size(f);
+  string str;
+  intvec v;
+  if (n>0)
+  {
+    int i;
+    int j;
+    for(i=1;i<=n;i++)
+    {
+      intvec w=leadexp(f);
+      for(j=1;j<=size(@variables);j++)
+      {
+        v[j]=w[j+1];
+      }
+      if(i==1)
+      {
+        str=print(leadcoef(f),"%s")+"*"+"U("+print(v,"%s")+")";
+      }
+      else
+      {
+        str=str+"+"+print(leadcoef(f),"%s")+"*"+"U("+print(v,"%s")+")";
+      }
+      kill w;
+      f=f-lead(f);
+    }
+  }
+  return(str);
+}
+example
+{
+"EXAMPLE:";echo=2;
+ list D="Ux","Ut","U";
+ list P="a";
+ list V="t","x";
+ setinitials(V,D,P);
+ scheme(u(Ut)+a*u(Ux),trapezoid(Ux,U,x),backward(Ut,U,t));
+ visualize(_);
+}
+
+///////////////////////////////////
+static proc imageideal()
+{
+
+  def n=size(@variables)-1;
+  ideal IDEAL=var(1),var(2);
+  int j;
+  for(j=1;j<=n;j++)
+  {
+    ideal II=var(2+j+n)+var(1)*var(2+2*n+j);
+    IDEAL=IDEAL+II;
+    kill II;
+  }
+  return(IDEAL);
+}
+/////////////////////////////////////
+proc u(string D,list #)
+"USAGE: u(D[,#]); D a string that occurs in the list of @derivatives, # an optional list of integers.
+RETURN: type vector; gives the vector, that corresponds with gen(n)*m, where m is the monomial defined by #
+EXAMPLE: example u; shows an example
+"
+{
+  def n=size(#);
+  def nv=nvars(basering)-1;
+  int nn;
+  if(nv<=n)
+  {
+    nn=nv;
+  }
+  else
+  {
+    nn=n;
+  }
+  int index=pos(D,@derivatives);
+  poly g=1;
+  if(nn>=1)
+  {
+    int j;
+    for(j=1;j<=nn;j++)
+    {
+      int nnn;
+      nnn=int(#[j]);
+      g=var(1+j)**nnn*g;
+      kill nnn;
+    }
+    return(gen(index)*g);
+  }
+  else
+  {
+    return(gen(index)*g);
+  }
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  list D="Ux","Uy","Ut","U";
+  list P="a","b";
+  list V="t","x","y";
+  setinitials(V,D,P);
+  u(Ux);
+  u(Ux,2,3,7);
+  u(Uy)+u(Ut)-u(Ux);
+  u(U)*234-dx*dt*dy*3*u(Uy);
+}
+
+/////////////////////////////////////////////////////////
+static proc pos(string D,list L)
+{
+  int j;
+  int index=-1;
+  def n=size(L);
+  for(j=1;j<=n;j++)
+  {
+    if(D==L[j])
+    {
+      index=j;
+    }
+  }
+  return(index);
+}
+///////////////////////////////////
+static proc re(list L)
+{
+  def n=size(L);
+  int j; string s;
+  for(j=1;j<=n;j++)
+  {
+    s="string "+print(L[j],"%s")+"="+"nameof("+print(L[j],"%s")+")"+";";
+    execute(s);
+    exportto(Top,`L[j]`);
+  }
+}
+///////////////////////////////////////////////
+proc scheme(list #)
+"USAGE:  scheme([v1,..,vn]); v1,..,vn of type vector
+RETURN:  poly
+PURPOSE: performs substitutions by the means of Groebner basis computation
+of the submodule, generated by the input vectors, then intersects the
+intermediate result with the suitable component in order to get a finite
+difference scheme
+NOTE:  works only for a single PDE, for the case of a system use @code{matrixsystem}
+EXAMPLE: example scheme; shows an example
+"
+{
+  def N=size(#);
+  if(N==0)
+  {
+    if(defined(M)==1)
+    {
+      kill M;
+      module M;
+    }
+    else
+    {
+      module M;
+    }
+  }
+  else
+  {
+    int j;
+    if(defined(M)==1)
+    {
+      kill M;
+      module M;
+      for(j=1;j<=N;j++)
+      {
+        M=M+#[j];
+      }
+    }
+    else
+    {
+      module M;
+      for(j=1;j<=N;j++)
+      {
+        M=M+#[j];
+      }
+    }
+  }
+  def S=getit(M);
+  matrix mat[1][1]=S;
+  list l=timestep(mat);
+  poly f=l[2][1,1];
+  return(f);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  list D="Ux","Ut","U";
+  list P="a";
+  list V="t","x";
+  setinitials(V,D,P);
+  def s1=scheme(u(Ut)+a*u(Ux),backward(Ux,U,x),forward(Ut,U,t));
+  s1;
+}
+////////////////////////
+static proc diffpar(poly ff)
+{
+  def gg=print(ff,"%s");
+  def str="d"+gg;
+  return(`str`);
+}
+////////////////////////
+proc laxfrT(string Ut, string U, poly space)
+"USAGE:   laxfrT(U1,U2,var); U1, U2 are the names of occuring derivatives, var is a variable in the basering;
+RETURN:   type vector; gives a predefined approximation of the Lax-Friedrich-approximation for the derivation in the timevariable as often used in literature;
+NOTE:     see also laxfrX, setinitials, scheme; Warning: laxfrT is not to be interchanged with laxfrX
+EXAMPLE:  example laxfrT; shows an example
+"
+{
+  poly time=var(2);
+  poly dtime=diffpar(time);
+  poly dspace=diffpar(space);
+  def v=dtime*space*u(Ut)-time*space*u(U)+1/2*(space**2*u(U)+u(U));
+  return(v);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  list D="Ux","Ut","U";
+  list P="a";
+  list V="t","x";
+  setinitials(V,D,P);
+  laxfrT(Ux,U,x);
+}
+////////////////////////
+proc laxfrX(string Ux, string U, poly space)
+"USAGE: laxfrX(U1,U2,var); U1, U2 are the names of occuring derivatives, var is a variable in the basering;
+RETURN: type vector; gives a predefined approximation of the Lax-Friedrich-approximation for the derivation in one of the spatial variables as often used in literature;
+NOTE:   see also laxfrT, setinitials, scheme; Warning: laxfrX is not to be interchanged with laxfrT
+EXAMPLE: example laxfrX; shows an example
+"
+{
+  poly dspace = diffpar(space);
+  def v=2*dspace*space*u(Ux)-(space**2-1)*u(U);
+  return(v);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  list D="Ux","Ut","U";
+  list P="a";
+  list V="t","x";
+  setinitials(V,D,P);
+  laxfrX(Ux,U,x);
+}
+////////////////////////
+proc forward(string U1,string U2,poly VAR)
+"USAGE:   forward(U1,U2,var); U1, U2 are the names of occuring derivatives, var is a variable in the basering;
+RETURN:   type vector; gives a predefined approximation of the forward approximation as often used in literature;
+NOTE:     see also laxfrT,setinitials,scheme;
+EXAMPLE:  example forward; shows an example
+"
+{
+  if(pos(U1,@derivatives)<pos(U2,@derivatives))
+    {
+      def V1=U1;
+      def V2=U2;
+    }
+  else
+    {
+      def V1=U2;
+      def V2=U1;
+    }
+  def v=diffpar(VAR)*u(V1)+u(V2)-VAR*u(V2);
+  return(v);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  list D="Ut","Ux","Uy","U";
+  list V="t","x","y";
+  list P="a","b";
+  setinitials(V,D,P);
+  forward(Ux,U,x);
+  forward(Uy,U,y);
+  forward(Ut,U,t);
+}
+///////////////////////
+proc backward(string U1,string U2,poly VAR)
+"USAGE:   backward(U1,U2,var); U1, U2 are the names of occuring derivatives, var is a variable in the basering;
+RETURN:   type vector; gives a predefined approximation of the backward approximation as often used in literature;
+NOTE:     see also forward,laxfrT,setinitials,scheme;
+EXAMPLE:  example backward; shows an example
+"
+{
+  if(pos(U1,@derivatives)<pos(U2,@derivatives))
+    {
+      def V1=U1;
+      def V2=U2;
+    }
+  else
+    {
+      def V1=U2;
+      def V2=U1;
+    }
+  def v=diffpar(VAR)*VAR*u(V1)+u(V2)-VAR*u(V2);
+  return(v);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  list D="Ut","Ux","Uy","U";
+  list V="t","x","y";
+  list P="a","b";
+  setinitials(V,D,P);
+  backward(Ux,U,x);
+  backward(Uy,U,y);
+  backward(Ut,U,t);
+}
+/////////////////////////////
+proc central1st(string U1,string U2,poly VAR)
+"USAGE:   central1st(U1,U2,var); U1, U2 are the names of occuring derivatives, var is a variable in the basering;
+RETURN:   type vector; gives a predefined approximation of the first-order-central-approximation as often used in literature;
+NOTE:     see also forward,laxfrT,setinitials,scheme;
+EXAMPLE:  example central1st; shows an example
+"
+{
+  if(pos(U1,@derivatives)<pos(U2,@derivatives))
+    {
+      def V1=U1;
+      def V2=U2;
+    }
+  else
+    {
+      def V1=U2;
+      def V2=U1;
+    }
+  def v=2*diffpar(VAR)*VAR*u(V1)+u(V2)-VAR**2*u(V2);
+  return(v);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  list D="Ut","Ux","Uy","U";
+  list V="t","x","y";
+  list P="a","b";
+  setinitials(V,D,P);
+  central1st(Ux,U,x);
+  central1st(Uy,U,y);
+}
+////////////////////////////////
+proc central2nd(string U1,string U2,poly VAR)
+"USAGE:   central2nd(U1,U2,var); U1, U2 are the names of occuring derivatives, var is a variable in the basering;
+RETURN:   type vector; gives a predefined approximation of the second-order-central-approximation as often used in literature;
+NOTE:     see also forward,laxfrT,setinitials,scheme;
+EXAMPLE:  example central2nd; shows an example
+"
+{
+  if(pos(U1,@derivatives)<pos(U2,@derivatives))
+    {
+      def V1=U1;
+      def V2=U2;
+    }
+  else
+    {
+      def V1=U2;
+      def V2=U1;
+    }
+  def v=diffpar(VAR)**2*VAR*u(V1)-(VAR**2*u(V2)-2*VAR*u(V2)+u(V2));
+  return(v);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  list D="Uxx","Ux","Utt","Ut","U";
+  list P="lambda";
+  list V="t","x";
+  setinitials(V,D,P);
+  central2nd(Uxx,U,x);
+  central2nd(Utt,U,t);
+}
+/////////////////////////////////
+proc trapezoid(string U1,string U2,poly VAR)
+"USAGE:   trapezoid(U1,U2,var); U1, U2 are the names of occuring derivatives, var is a variable in the basering;
+RETURN:   type vector; gives a predefined approximation of the trapezoid-approximation as often used in literature;
+NOTE:     see also forward,laxfrT,setinitials,scheme;
+EXAMPLE:  example trapezoid; shows an example
+"
+{
+  if(pos(U1,@derivatives)<pos(U2,@derivatives))
+    {
+      def V1=U1;
+      def V2=U2;
+    }
+  else
+    {
+      def V1=U2;
+      def V2=U1;
+    }
+  def v=1/2*diffpar(VAR)*(VAR+1)*u(V1)+(1-VAR)*u(V2);
+  return(v);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  list D="Uxx","Ux","Utt","Ut","U";
+  list P="lambda";
+  list V="t","x";
+  setinitials(V,D,P);
+  trapezoid(Uxx,Ux,x);
+  trapezoid(Ux,U,x);
+}
+///////////////////////////////////
+proc midpoint(string U1,string U2,poly VAR)
+"USAGE:   midpoint(U1,U2,var); U1, U2 are the names of occuring derivatives, var is a variable in the basering;
+RETURN:   type vector; gives a predefined approximation of the midpoint-approximation as often used in literature;
+NOTE:     see also forward,laxfrT,setinitials,scheme;
+EXAMPLE:  example midpoint; shows an example
+"
+{
+  if(pos(U1,@derivatives)<pos(U2,@derivatives))
+    {
+      def V1=U1;
+      def V2=U2;
+    }
+  else
+    {
+      def V1=U2;
+      def V2=U1;
+    }
+  def v=2*diffpar(VAR)*VAR*u(V1)+(1-VAR**2)*u(V2);
+  return(v);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  list D="Uxx","Ux","Utt","Ut","U";
+  list P="lambda";
+  list V="t","x";
+  setinitials(V,D,P);
+  midpoint(Ux,U,x);
+}
+//////////////////////////////////////
+proc pyramid(string U1,string U2,poly VAR)
+"USAGE:   pyramid(U1,U2,var); U1, U2 are the names of occuring derivatives, var is a variable in the basering;
+RETURN:   type vector; gives a predefined approximation of the pyramid-approximation as often used in literature;
+NOTE:     see also forward,laxfrT,setinitials,scheme;
+EXAMPLE:  example pyramid; shows an example
+"
+{
+  if(pos(U1,@derivatives)<pos(U2,@derivatives))
+    {
+      def V1=U1;
+      def V2=U2;
+    }
+  else
+    {
+      def V1=U2;
+      def V2=U1;
+    }
+  def v=1/3*diffpar(VAR)*(VAR**2+VAR+1)*u(V1)+(VAR-VAR**3)*u(V2);
+  return(v);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  list D="Uxx","Ux","Utt","Ut","U";
+  list P="lambda";
+  list V="t","x";
+  setinitials(V,D,P);
+  pyramid(Ux,U,x);
+}
+//////////////////////////////////////////////
+proc setinitials(list variable, list der,list #)
+"USAGE:  setinitials(V,D[,P]); V,D,P are lists with strings as elements
+RETURN:  no return value: sets the dependence order of the occuring derivatives,
+constructs the suitable ring to compute in containing user chosen parameters, sets new basering
+NOTE:    P is optional, used to introduce some additional parameters into the ring. The Sine and
+Cosine values needed for the fourier transformation are symbolically introduced under the names
+string(c)+nameof(variable), i.e. if x is any spatial variable then cx:=cosine(dx*ksi), when
+regarding the fourier transform after ksi (for sine respectively). Artificial parameters I,T,Px,Py
+are introduced for the later eigenvalue analysis. Variables can be transformed into parameters
+of similar name
+EXAMPLE: example setinitials; shows an example
+"
+{
+  def LV=variable;
+  def @variables=variable;
+  def @derivatives=der;
+  export(@variables);
+  export(@derivatives);
+  re(der);
+  int j;
+  string dvar="d"+print(LV[1],"%s");
+  dvar=dvar+","+"d"+print(LV[2],"%s");
+  string pvar="P"+print(LV[2],"%s");
+  string COS="C"+print(LV[2],"%s");
+  string SIN="S"+print(LV[2],"%s");
+  for(j=3;j<=size(LV);j++)
+    {
+      dvar=dvar+","+"d"+print(LV[j],"%s");
+      pvar=pvar+","+"P"+print(LV[j],"%s");
+      COS=COS+","+"C"+print(LV[j],"%s");
+      SIN=SIN+","+"S"+print(LV[j],"%s");
+    }
+  string scf="(0,"+"I,"+"T,"+pvar+","+COS+","+SIN+","+print(#,"%s")+","+dvar+")";  //coefficient_field
+  string svars="(i";
+  kill j;
+  int j;
+  for(j=1;j<=size(LV);j++)
+    {
+      svars=svars+","+print(LV[j],"%s");
+    }
+  string cosine;
+  string sine;
+  kill j;
+  int j;
+  cosine="c"+print(LV[2],"%s");
+  sine="s"+print(LV[2],"%s");
+  for(j=3;j<=size(LV);j++)
+    {
+      cosine=cosine+","+"c"+print(LV[j],"%s");
+      sine=sine+","+"s"+print(LV[j],"%s");
+    }
+  kill j;
+  string strvar=cosine+","+sine+")";
+  svars=svars+","+strvar;            ////variables
+  string sord="(c,lp)";         ////ordering
+  ring Q = create_ring(scf, svars, sord);
+  ideal Id=i**2+1;
+  int j;
+  for(j=1;j<=size(LV)-1;j++)
+    {
+      ideal II=var(2+j+size(LV)-1)**2+var(2+j+2*(size(LV)-1))**2-1;
+      Id=Id+II;
+      kill II;
+    }
+  if(defined(basering)==1)
+    {
+      kill basering;
+    }
+  qring R=std(Id);
+  setring R;
+  // comment by VL: it's better to return this ring! causes many changes
+  // across the library
+  export(R);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  list D="Ut","Ux","Uy","U";
+  list V="t","x","y";
+  list P="alpha","beta","gamma";
+  setinitials(V,D,P);////does not show the ring, since there is no output
+  basering;///does show the ring
+}
+////////////////////////////
+proc errormap(poly f)
+"USAGE:    errormap(f); f of type poly
+RETURN:   type poly; performs the fouriertransformation of a single polynomial
+EXAMPLE:  example errormap; shows an example
+"
+{
+  ideal Id=imageideal();
+  map phi=R,Id;
+  def g=phi(f);
+  g=reduce(g,std(0));
+  return(g);
+}
+example
+{
+  "EXAMPLE";echo=2;
+  list D="Ux","Ut","U";
+  list P="a";
+  list V="t","x";
+  setinitials(V,D,P);
+  scheme(u(Ut)+a*u(Ux),central1st(Ux,U,x),backward(Ut,U,t));
+  errormap(_);
+}
+/////////////////////////////////////
+static proc stepmatrix(int n, poly f)
+{
+  int spavars=size(@variables)-1;
+  int range=n*spavars;
+  if(f==0)
+    {
+      return(unitmat(range));
+    }
+  matrix M[range][range];
+  int length=size(f);
+  intvec max=maxexp(f);
+  int i;
+  intvec shiftback;
+  intvec vzero;
+  intvec vmax;
+  intvec shiftforward;
+  for(i=1;i<=size(max);i++)
+    {
+     shiftback[i]=int(floor(max[i]/2));
+     vzero[i]=0;
+     vmax[i]=n-1;
+     shiftforward[i]=0;
+    }
+  kill i;
+  int i;
+  for(i=1;i<=range;i++)
+    {
+      poly g=f;
+    }
+  kill i;
+}
+//////////////////////////////////////
+static proc floor(n)
+{
+  number h1=numerator(n);
+  number h2=denominator(n);
+  return((h1- (h1 mod h2))/h2);
+}
+/////////////////////////////////////
+static proc maxexp(poly f)
+{
+  int length=size(f);
+  poly g=f;
+  intvec v;
+  int i;
+  for(i=1;i<size(@variables);i++)
+    {
+      v[i]=leadexp(g)[i+2];
+    }
+  while(g!=0)
+    {
+      int j;
+      for(j=1;j<size(@variables);j++)
+  {
+    v[j]=maximal(leadexp(g)[j+2],v[j]);
+    g=g-lead(g);
+  }
+      kill j;
+    }
+  return(v);
+}
+////////////////////////////////////
+static proc maximal(int n1,int n2)
+{
+  if(n1>n2)
+    {
+      return(n1);
+    }
+  else
+    {
+      return(n2);
+    }
+}
+////////////////////////////////////
+static proc minimal(int n1, int n2)
+{
+  return(-maximal(-n1,-n2));
+}
+////////////////////////////////////
+static proc MatrixEntry(int n, intvec v)
+{
+  int j;
+  int entry;
+  int spavar=size(@variables)-1;
+  for(j=1;j<=spavar;j++)
+    {
+      entry=entry+v[j]*n**(spavar-j);
+    }
+  entry=entry+1;
+  return(entry);
+}
+//////////////////////////////////
+static proc CompareVec(intvec ToTest, intvec Reference)//1 if ToTest>=Reference, 0 else
+{
+  int i;
+  for(i=1;i<=size(@variables)-1;i++)
+    {
+      if(ToTest[i+2]<Reference[i])
+  {
+    return(0);
+  }
+    }
+  return(1);
+}
+/////////////////////////////////
+static proc MaxVecZero(intvec ToTest, intvec Reference) //KGV, size=size(input)
+{
+  int length=size(ToTest);
+  int i;
+  intvec Maximum;
+  for(i=1;i<=length;i++)
+    {
+      Maximum[i]=maximal(ToTest[i],Reference[i]);
+    }
+  return(Maximum);
+}
+//////////////////////////////////
+proc matrixsystem(list Matrices,list Approx)
+"USAGE:   matrixsystem(M,A); where the M=Mt,M1,..,Mn is a list with square matrices of the same dimension as entries, and A=At,A1,..,An gives the corresponding approximations for the several variables (t,x1,..,xn) as vector. Intended to solve Mt*U_t + M1*U_x1+..+Mn*U_xn=0 as a linear sytem of partial differential equations numerically by a finite difference scheme;
+RETURN:   type matrix; gives back the matrices B1,B2 that represent the finite difference scheme, partitioned into different time levels in the form:  B1*U(t=N)=B2*U(t<N), where N is the maximal occurring degree (timelevel) of t.
+EXAMPLE:  example matrixsystem; shows an example
+"
+{
+  if(size(Matrices)>size(@variables) or size(Matrices)!=size(Approx))
+    {
+      ERROR("Check number of variables: it must hold  #(matrices)<= #(spatial variables)+1  !!! ");
+    }
+  if(size(Matrices)!=size(Approx))
+    {
+      ERROR("Every variable needs EXACTLY ONE approximation rule, i.e. #(first argument) =#(second argument) ! ");
+    }
+  ideal Mon=leadmonomial(Approx[1]);
+  int N=size(Matrices);
+  int i;
+  for(i=2;i<=N;i++)
+    {
+      Mon=Mon,leadmonomial(Approx[i]);
+    }
+  kill i;
+  poly LCM=lcm(Mon);
+  matrix M[nrows(Matrices[1])][ncols(Matrices[1])];
+  int i;
+  for(i=1;i<=size(Matrices);i++)
+    {
+      M=M+(LCM/leadmonomial(Approx[i]))*normalize(Approx[i])[size(@derivatives)]*Matrices[i];
+    }
+  kill i;
+  return(M);
+}
+example
+{
+  "EXAMPLE:";echo=2;
+  list D="Ut","Ux","Uy","U";
+  list V="t","x","y";
+  list P="a","b";
+  setinitials(V,D,P);
+  list Mat=unitmat(2),unitmat(2);
+  list Appr=forward(Ut,U,t),forward(Ux,U,x);
+  matrixsystem(Mat,Appr);
+}
+//////////////////////////////////
+proc timestep(matrix M)
+"USAGE:   timestep(M); M a square matrix with polynomials over the basering as entries;
+RETURN:   type list; gives two  matrices M1,M2 that are the splitting of M with respect to the degree of the variable t in the entries, where the first list-entry M1 consists of the polynomials of the highest timelevel and M2 of the lower levels in the form:  M=0  =>  M1=M2,    i.e. M1-M2=M
+NOTE:     intended to be used for the finite-difference-scheme-construction and partition into the several time steps
+EXAMPLE:  example timestep; shows an example
+"
+{
+  int N=nrows(M);
+  int i;
+  int maxdegT;
+  for(i=1;i<=N;i++)
+    {
+      int j;
+      for(j=1;j<=N;j++)
+  {
+    poly f=M[i,j];
+    int k;
+    for(k=1;k<=size(f);k++)
+      {
+        if(leadexp(M[i,j])[2]>maxdegT)
+    {
+      maxdegT=leadexp(M[i,j])[2];
+    }
+        f=f-lead(f);
+      }
+    kill f;
+    kill k;
+  }
+      kill j;
+    }
+  kill i;
+  matrix highT[nrows(M)][nrows(M)];
+  vector leftside=0;
+  int GenIndex=0;
+  int i;
+  for(i=1;i<=N;i++)
+    {
+      int j;
+      for(j=1;j<=N;j++)
+  {
+    poly f=M[i,j];
+    int k;
+    for(k=1;k<=size(f)+1;k++)
+      {
+        if(leadexp(f)[2]==maxdegT)
+    {
+      GenIndex++;
+      highT[i,j]=highT[i,j]+lead(f);
+      leftside=leftside+highT[i,j]*gen(GenIndex);
+    }
+        f=f-lead(f);
+      }
+    kill k;
+    kill f;
+  }
+      kill j;
+    }
+  kill i;
+  matrix tUpper=highT;
+  matrix tLower=-1*(M-tUpper);
+  tUpper=tUpper/content(leftside);
+  tLower=tLower/content(leftside);
+  list L=tUpper,tLower;
+  return(L);
+}
+example
+{
+  "EXAMPLE:"; echo=2;
+  list D="Ut","Ux","Uy","U";
+  list V="t","x","y";
+  list P="a","b";
+  setinitials(V,D,P);
+  list Mat=unitmat(2),unitmat(2);
+  list Apr=forward(Ut,U,t),forward(Ux,U,x);
+  matrixsystem(Mat,Apr);
+  timestep(_);
+}
+//////////////////////////////////
+proc fouriersystem(list Matrices, list Approx)
+"USAGE:   fouriersystem(M,A); M a list of matrices, A a list of approximations;
+RETURN:   type list; each entry is some matrix obtained by performing the substitution of the single approximations into the system of pde's, partitioning the equation into the several timesteps and fouriertransforming these parts
+EXAMPLE:  example fouriersystem; shows an example
+"
+{
+  matrix M=matrixsystem(Matrices,Approx);
+  matrix T1=timestep(M)[1];
+  matrix T0=timestep(M)[2];
+  int i;
+  for(i=1;i<=nrows(M);i++)
+    {
+      int j;
+      for(j=1;j<=nrows(M);j++)
+  {
+    T1[i,j]=errormap(T1[i,j]);
+    T1[i,j]=VarToPar(T1[i,j]);
+    T0[i,j]=errormap(T0[i,j]);
+    T0[i,j]=VarToPar(T0[i,j]);
+  }
+      kill j;
+    }
+  kill i;
+  ideal EV1=eigenvals(T1)[1];
+  ideal EV0=eigenvals(T0)[1];
+  list L=list(T1,T0),list(EV1,EV0);
+  def N1=size(EV1);
+  def N0=size(EV0);
+  list CV1;
+  list CV0;
+  int i;
+  for(i=1;i<=N1;i++)
+  {
+  CV1[i]=VarToPar(EV1[i]);
+  if(content(CV1[i])==CV1[i])
+  {
+  CV1[i]=content(CV1[i]);
+  CV1[i]=VarToPar(ComplexValue(numerator(CV1[i])))/VarToPar(ComplexValue(denominator(CV1[i])));
+  }
+  }
+  kill i;
+  int i;
+  for(i=1;i<=N0;i++)
+  {
+  CV0[i]=VarToPar(EV0[i]);
+  if(content(CV0[i])==CV0[i])
+  {
+  CV0[i]=content(CV0[i]);
+  CV0[i]=VarToPar(ComplexValue(numerator(CV0[i])))/VarToPar(ComplexValue(denominator(CV0[i])));
+  }
+  }
+  kill i;
+  list CV=list(CV1,CV0);
+  L=L,CV;
+  return(L);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  list D="Ut","Ux","Uy","U";
+  list V="t","x","y";
+  list P="a","b";
+  setinitials(V,D,P);
+  matrix M[2][2]=0,-a,-a,0;
+  list Mat=unitmat(2),M;
+  list Appr=forward(Ut,U,t),trapezoid(Ux,U,x);
+  def s=fouriersystem(Mat,Appr);s;
+}
+//////////////////////////////////
+proc PartitionVar(poly f,int n)
+"USAGE:   PartitionVar(f); f a poly in the basering;
+RETURN:   type poly; gives back a list L=f1,f2 obtained by the partition of f into two parts f1,f2 with deg_var_n(f1) >0  deg_var_n(f2)=0
+EXAMPLE:  example PartitionVar; shows an example
+"
+{
+  if(n>=nvars(basering))
+    {
+      ERROR("this variable does not exist in the current basering");
+    }
+  int i;
+  poly partition=0;
+  poly g=f;
+  for(i=1;i<=size(f);i++)
+    {
+      if(leadexp(g)[n]!=0)
+  {
+    partition=partition+lead(g);
+  }
+      g=g-lead(g);
+    }
+  list L=partition,f-partition;
+  return(L);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  list D="Ut","Ux","Uy","U";
+  list V="t","x","y";
+  list P="a","b";
+  setinitials(V,D,P);////does not show the ring, since there is no output
+  basering;///does show the ring
+  poly f=t**3*cx**2-cy**2*dt+i**3*sx;
+  PartitionVar(f,1); ////i is the first variable
+}
+//////////////////////////////////
+proc ComplexValue(poly f)
+"USAGE:   ComplexValue(f); f a poly in the basering;
+RETURN:   type poly; gives back the formal complex-value of f, where var(1) is redarded as the imaginary unit. Does only make sense, if the proc <setinitials> is executed before -> nvars <= npars
+EXAMPLE:  example ComplexValue; shows an example
+"
+{
+  poly g=ParToVar(f);
+  def L=PartitionVar(g,1);
+  poly f1=subst(L[1],var(1),1);
+  poly f2=L[2];
+  poly result=reduce(f1**2+f2**2,std(0));
+  return(result);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  list D="Ut","Ux","Uy","U";
+  list V="t","x","y";
+  list P="a","b";
+  setinitials(V,D,P);////does not show the ring, as there is  no output
+  basering;///does show the ring
+  poly f=t**3*cx**2-cy**2*dt+i**3*sx;
+  f;
+  ComplexValue(f);
+}
+//////////////////////////////////
+proc VarToPar(poly f)
+"USAGE:   VarToPar(f); f a poly in the basering;
+RETURN:   type poly; gives back the poly obtained by substituting var(i) by par(i), for all variables. Does only make sense, if the proc <setinitials> is executed before -> nvars <= npars;
+EXAMPLE:  example VarToPar; shows an example
+"
+{
+  int N=nvars(basering);
+  int i;
+  def g=f;
+  for(i=1;i<=N;i++)
+    {
+      g=subst(g,var(i),par(i));
+    }
+  return(g);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  list D="Ut","Ux","Uy","U";
+  list V="t","x","y";
+  list P="a","b";
+  setinitials(V,D,P);////does not show the ring, as there is  no output
+  basering;///does show the ring
+  poly f=t**3*cx**2-cy**2*dt+i**3*sx;
+  f;
+  VarToPar(f);
+}
+/////////////////////////////////////
+proc ParToVar(poly f)
+"USAGE:   ParToVar(f); f a poly in the basering;
+RETURN:   type poly; gives back the poly obtained by substituting par(i) by var(i), for the first nvars(basering parameters. Does only make sense, if setinitials is executed before -> nvars <= npars. Is the opposite action to VarToPar, see example ParToVar;
+EXAMPLE:  example ParToVar; shows an example
+"
+{
+  int N=nvars(basering);
+  int i;
+  number g=number(VarToPar(f));
+  number denom=denominator(g);
+  g=denom*g;
+  def gg=subst(g,par(1),var(1));
+  for(i=2;i<=N;i++)
+    {
+      gg=subst(gg,par(i),var(i));
+    }
+  return(gg/denom);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  list D="Ut","Ux","Uy","U";
+  list V="t","x","y";
+  list P="a","b";
+  setinitials(V,D,P);////does not show the ring, as there is  no output
+  basering;///does show the ring
+  poly f=t**3*cx**2-cy**2*dt+i**3*sx/dt*dx;
+  f;
+  def g=VarToPar(f);
+  g;
+  def h=ParToVar(g);
+  h==f;
+}
+/////////////////////////////////////////
+proc qepcad(poly f)
+"USAGE:   qepcad(f); f a poly in the basering;
+RETURN:   type list; gives back some constraints that are equivalent to f<1 (computed by QEPCAD);
+EXAMPLE:  example qepcad; shows an example
+"
+{
+  // how to test, whether QEPCAD is installed?
+  createQCfilter(); // creates/overwrites qepcadfilter.pl
+  system("sh","rm -f QEPCAD-out");
+  system("sh","rm -f QEPCAD-in");
+  if(denominator(content(f))==1)
+  {
+    poly g=f-1;
+  }
+  else
+  {
+    if(f==content(f))
+    {
+      poly g=f*denominator(content(f))-1*denominator(content(f));
+      g=ParToVar(g);
+      g=reduce(g,std(0));
+    }
+    else
+    {
+      poly g=cleardenom(f)-1/content(f);
+      g=ParToVar(g);
+      g=reduce(g,std(0));
+    }
+  }
+  string in="QEPCAD-in";
+  string out="QEPCAD-out";
+  link l1=in;
+  link l2=out;
+  string s1="[trial]";    //description
+  string s2=varlist();    //the variables
+  string s3=nfreevars();  //number of free variables
+  string s4=aquantor()+"["+writepoly(g)+rel()+"]."; //the input prenex formula
+  string s5=projection();
+  string s6=projection();
+  string s7=choice();
+  string s8=solution();
+  write(l1,s1,s2,s3,s4,s5,s6,s7,s8);
+  system("sh","qepcad < QEPCAD-in | qepcadfilter.pl > QEPCAD-out");
+  string output=read(out);
+  print(output,"%s");
+  if(size(output)==0)
+  {
+    return("Try manually");    //maybe too few cells
+  }
+  if(find(output,"FALSE")!=0)
+  {
+    return("FALSE");
+  }
+  if(find(output,"WARNING")!=0)
+  {
+    return("WARNING! Try manually");
+  }
+  else
+  {
+    string strpolys=findthepoly(output);
+    list lpolys=listpolynew(strpolys);
+    return(lpolys);
+  }
+  system("sh","rm -f QEPCAD-out");
+  system("sh","rm -f QEPCAD-in");
+
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  list D="Ux","Ut","U";
+  list P="a";
+  list V="t","x";
+  setinitials(V,D,P);
+  def s1=scheme(u(Ut)+a*u(Ux),laxfrX(Ux,U,x),laxfrT(Ut,U,x));
+  s1;
+  def s2=errormap(s1);
+  s2;
+  def s3=ComplexValue(s2);s3;
+  qepcad(s3);
+}
+///////////////////////////////////////////
+proc createQCfilter()
+{
+  // writes the following to the file qepcadfilter.pl
+  // is there already such a file? remove it!
+  system("sh","rm -f qepcadfilter.pl");
+  link l=":w qepcadfilter.pl";
+  write(l, "#!/usr/bin/perl");
+  write(l, "$flag = 0;");
+  write(l, "$res = \"\";");
+  write(l,"while(<>)");
+  write(l,"{ if ($_ =~ /Warning|WARNING|warning|Error|error|ERROR/) { print $_; }");
+  write(l,"elsif ($_ =~ /An\ equivalent/) { $flag = 1; }");
+  write(l,"elsif ($flag == 1 && $_ ne \"\n\") { print $_; $flag = 0; } }");
+}
+
+///////////////////////////////////////////
+proc qepcadsystem(list l)
+"USAGE:  qepcadsytem(f); l a list;
+RETURN:  list
+PURPOSE: gives back some constraints that are equivalent to the
+eigenvalues of the matrices in the list l being < 1 (computed by QEPCAD)
+EXAMPLE:  example qepcadsystem; shows an example
+"
+{
+  // how to test, whether QEPCAD is installed?
+  createQCfilter(); // creates/overwrites qepcadfilter.pl
+  system("sh","rm -f QEPCAD-out");
+  system("sh","rm -f QEPCAD-in");
+  string in="QEPCAD-in";
+  string out="QEPCAD-out";
+  link l1=in;
+  link l2=out;
+  string s1="[trial]";    //description
+  string s2=varlist();    //the variables
+  string s3=nfreevars();  //number of free variables
+  string thepolys;
+  int n2=size(l[2]);
+  int count;
+  int i;
+  list lpolys;
+  int j;
+  for(j=1;j<=n2;j++)
+  {
+    count++;
+    poly g2=ParToVar(l[2][j]);
+    if(denominator(content(g2))==1)
+    {
+      lpolys[count]=writepoly(ParToVar(reduce(g2-1,std(0))))+rel();
+    }
+    else
+    {
+      if(g2==content(g2))
+      {
+        g2=g2*denominator(content(g2))-1*denominator(content(g2));
+        g2=ParToVar(g2);
+        g2=reduce(g2,std(0));
+        lpolys[count]=writepoly(g2)+rel();
+      }
+      else
+      {
+        lpolys[count]=writepoly(reduce(ParToVar(cleardenom(g2)-1/content(g2)),std(0)))+rel();
+      }
+    }
+    kill g2;
+  }
+  kill j;
+  int k;
+  for(k=1;k<=size(lpolys);k++)
+  {
+    thepolys=thepolys+lpolys[k];
+    if(k<size(lpolys))
+    {
+      thepolys=thepolys+print(" /","s%")+print("\\ ","s%");
+    }
+  }
+  string s4=aquantor()+"["+thepolys+"]."; //the input prenex formula
+  string s5=projection();
+  string s6=projection();
+  string s7=choice();
+  string s8=solution();
+  write(l1,s1,s2,s3,s4,s5,s6,s7,s8);
+  system("sh","qepcad < QEPCAD-in | qepcadfilter.pl > QEPCAD-out");
+  string output=read(out);
+  print(output,"%s");
+  if(size(output)==0)
+  {
+    ERROR("Try manually");    //maybe too few cells
+  }
+  if(find(output,"FALSE")!=0)
+  {
+    ERROR("FALSE");
+  }
+  if(find(output,"WARNING")!=0)
+  {
+    ERROR("WARNING! Try manually");
+  }
+  else
+  {
+    string strpolys=findthepoly(output);
+    list llpolys=listpolynew(strpolys);
+    return(llpolys);
+  }
+  system("sh","rm -f QEPCAD-out");
+  system("sh","rm -f QEPCAD-in");
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  list D="Ut","Ux","Uy","U";
+  list V="t","x","y";
+  list P="a","b";
+  setinitials(V,D,P);
+  matrix M[2][2]=0,-a,-a,0;
+  list Mat=unitmat(2),M;
+  list Appr=forward(Ut,U,t),forward(Ux,U,x);
+  //matrixsystem(Mat,Appr);
+  //timestep(_);
+  fouriersystem(Mat,Appr);
+  qepcadsystem(_[2]);
+}
+///////////////////////////////////////////
+static proc substbracketstar(string s)
+{
+  int i;
+  int k;
+  int index=1;
+  string finish=s;
+  for(k=1;k<=size(s);k++)
+  {
+    if(finish[1]=="(" or finish[1]=="*" or finish[1]==" ")
+    {
+      kill finish;
+      index=index+1;
+      string finish=s[index..size(s)];
+    }
+  }
+  for(i=1;i<=size(finish);i++)
+  {
+    if(finish[i]=="*" or finish[i]=="(" or finish[i]== ")")
+    {
+      finish[i]=" ";
+    }
+  }
+  return(finish);
+}
+
+////////////////////////////////////
+static proc distribution(string SUM, string MON)
+{
+  string sum=substbracketstar(SUM);
+  string mon=substbracketstar(MON);
+  string result;
+  list signs;
+  list p;
+  int i;
+  int j;
+  int init;
+  for(i=2;i<=size(sum);i++)
+  {
+    if(sum[i]=="+" or sum[i]=="-")
+    {
+      j++;
+      p[j]=i;
+    }
+  }
+  if(j==0)
+  {
+    if(sum[1]!="-")
+    {
+      result=sum+" "+" "+mon;
+      result="+"+" "+result;
+    }
+    else
+    {
+      result=sum+" "+mon;
+    }
+  }
+  else
+  {
+    int l;
+    int anfang;
+    if(sum[1]=="-")
+    {
+      result="-"+" "+result;
+      anfang=2;
+    }
+    else
+    {
+      result="+"+" "+result;
+      if(sum[1]=="+")
+      {
+        anfang=2;
+      }
+      else
+      {
+        anfang=1;
+      }
+    }
+    for(l=1;l<=j;l++)
+    {
+      string a;
+      int k;
+      for(k=anfang;k<=p[l]-1;k++)
+      {
+        a=a+sum[k];
+      }
+      result=result+" "+a+" "+mon+" "+sum[p[l]];
+      anfang=p[l]+1;
+      kill a;
+      kill k;
+    }
+    if(p[j]<size(sum))
+    {
+      int kk;
+      string aa;
+      for(kk=anfang;kk<=size(sum);kk++)
+      {
+        aa=aa+sum[kk];
+      }
+      result=result+" "+aa+" "+mon;
+      kill aa;
+      kill kk;
+    }
+    else
+    {
+      int kkk;
+      string aaa;
+      for(kkk=anfang;kkk<size(sum);kkk++)
+      {
+        aaa=aaa+sum[kkk];
+      }
+      result=result+" "+aaa+" "+mon;
+      kill aaa;
+      kill kkk;
+    }
+  }
+  return(result);
+}
+/////////////////////////////////////////////////////////////////
+static proc writepoly(poly f)
+{
+  poly g=f;
+  string lc;
+  string lm;
+  string strpoly;
+  string intermediate;
+  int n=size(f);
+  int i;
+  for(i=1;i<=n;i++)
+  {
+
+    lc=substbracketstar(string(leadcoef(g)));
+    lm=substbracketstar(string(leadmonom(g)));
+    intermediate=distribution(lc,lm);
+    strpoly=strpoly+" "+intermediate;
+    g=g-lead(g);
+  }
+  return(strpoly);
+}
+///////////////////////////////////////////////////////////////
+static proc varlist()
+{
+  poly p1=par(2+size(@variables));
+  p1=ParToVar(p1);
+  string name=print(p1,"%s");
+  string p="("+name+",";
+  int i;
+  for(i=3+size(@variables);i<=npars(basering);i++)
+  {
+    p1=ParToVar(par(i));
+    name=substbracketstar(print(p1,"%s"));
+    p=p+name+",";
+  }
+  p1=ParToVar(par(2));
+  name=print(p1,"%s");
+  p=p+name+")";
+  return(p);
+}
+///////////////////////////////////////////////////////
+static proc normalization()
+{
+  int n1=npars(basering)-size(@variables);
+  int n2=npars(basering)-n1;
+  string assumption="assume["+" "+substbracketstar(print(par(n1+1),"%s"))+" >0";
+  int i;
+  for(i=2;i<=n2;i++)
+  {
+    string s=" /\\"+" "+substbracketstar(print(par(n1+i),"%s"))+" >0";
+    assumption=assumption+" "+s;
+    kill s;
+  }
+  assumption=assumption+" ]"+newline+"go";
+  return(assumption);
+}
+///////////////////////////////////////////////////////
+static proc projection()
+{
+  string s="go";
+  return(s);
+}
+///////////////////////////////////////////////////////
+static proc choice()
+{
+  string s="go";
+  return(s);
+}
+///////////////////////////////////////////////////////
+static proc solution()
+{
+  string s="go";
+  return(s);
+}
+///////////////////////////////////////////////////////
+static proc nfreevars()
+{
+  int n=npars(basering)-size(@variables)-1;
+  string no=print(n,"%s");
+  return(no);
+}
+/////////////////////////////////////////////////////////
+static proc aquantor()
+{
+  string s="(A "+print(var(2),"%s")+")";
+  return(s);
+}
+////////////////////////////////////////////////////////
+static proc rel()
+{
+  return("<0");
+}
+/////////////////////////////////////////////////////////
+static proc rm()
+{
+  system("sh","rm -f dummy");
+  system("sh","rm -f QEPCAD-in");
+}
+////////////////////////////////////////////////////////
+static proc findthepoly(string word)
+{
+  int init=1;
+  int index=find(word,newline);
+  if(index==size(word) or index== 0)
+  {
+    return(word);
+  }
+  else
+  {
+    while(index<size(word))
+    {
+      init=index;
+      index=find(word,newline,index+1);
+    }
+  }
+  string thepoly=word[(init+1)..(size(word)-1)];
+  return(thepoly);
+}
+//////////////////////////////////////////////////
+static proc listpolynew(string thepoly)
+{
+  string p=thepoly;
+  intvec v;
+  p=TestAndDelete(p,"[")[1];
+  p=TestAndDelete(p,"]")[1];    //remove the brackets
+  string AND="/"+"\\";
+  string OR="\\"+"/";
+  list thesigns=AND,OR,"~","<==>","==>","<==";///these can occur in QEPCAD
+  int i;
+  for(i=1;i<=size(thesigns);i++)
+  {
+    list l=TestAndDelete(p,thesigns[i]);
+    p=l[1];
+    v=addintvec(v,l[2]);
+    kill l;
+  }
+  intvec w=rightorder(v);
+  int N=size(v);
+  list lstrings;
+  if(size(w)==1 and w[1]==0)
+  {
+    N=0;
+    lstrings[1]=p;
+  }
+  else
+  {
+    string s1=p[1..w[1]-1];
+    lstrings[1]=s1;
+    int j;
+    for(j=1;j<N;j++)
+    {
+      string s2=p[w[j]..w[j+1]-1];
+      lstrings[j+1]=s2;
+      kill s2;
+    }
+    string s3=p[w[N]..size(p)];
+    lstrings[N+1]=s3;
+  }
+  list cutstrings;
+  int k;
+  list Id;
+  for(k=1;k<=N+1;k++)
+  {
+    cutstrings[k]=cutoffrel(lstrings[k]);
+    Id[k]=translatenew(cutstrings[k]);
+  }
+  return(Id);
+
+
+}
+/////////////////////////////////////////////////
+static proc translatenew(string word)
+{
+  int n=size(word);
+  string subword=word[1..n];
+  string strpoly="poly f=";
+  list linterim;
+  int i;
+  for(i=1;i<=n;i++)
+  {
+    if(i<n and subword[i]==" " and subword[i+1]!="+" and subword[i+1]!="-" and subword[i+1]!=" " and subword[i-1]!="+" and subword[i-1]!="-" and subword[i-1]!=" " and i>1)
+    {
+      linterim[i]="*";
+    }
+    else
+    {
+      linterim[i]=word[i];
+    }
+    strpoly=strpoly+print(linterim[i],"%s");
+  }
+  strpoly=strpoly+";";
+  execute(strpoly);
+  return(f);
+}
+//////////////////////////////////////////////////
+static proc rightorder(intvec v)
+////////////orders the entries of an intvec from small to bigger
+{
+  list ldown=intveclist(v);
+  list lup;
+  intvec v1;
+  int counter;
+  int min;
+  int i;
+  for(i=1;i<=size(v);i++)
+  {
+    min=Min(listintvec(ldown));
+    lup[i]=min;
+    counter=listfind(ldown,min);
+    ldown=delete(ldown,counter);
+  }
+  intvec result=listintvec(lup);
+  return(result);
+}
+/////////////////////////////////////////////////
+static proc listfind(list l, int n)
+//////gives the position of n in l, 0 if not found
+{
+  int i;
+  intvec counter;
+  int j=1;
+  for(i=1;i<=size(l);i++)
+  {
+    if(n==l[i])
+    {
+      counter[j]=i;
+      j++;
+    }
+  }
+  int result=Min(counter);
+  return(result);
+}
+//////////////////////////////////////////////////
+static proc cutoffrel(string str)
+/////////cut off the relations "/=,<= etc." from output-string
+{
+  list rels="<=",">=","<",">","/=","=";  //these are all of qepcad's relations
+  int i;
+  list l;
+  for(i=1;i<=size(rels);i++)
+  {
+    l[i]=find(str,rels[i]);
+  }
+  intvec v=listintvec(l);
+  v=addintvec(v,v);
+  int position=Min(v);
+  string result;
+  if(position==0)
+  {
+    result=str;
+  }
+  else
+  {
+    result=str[1..position-1];
+  }
+  return(result);
+}
+//////////////////////////////////////////////////
+static proc addintvec(intvec v1, intvec v2)
+///////concatenates two intvecs and deletes occurring zeroentries, output intvec
+{
+  list lresult;
+  int i;
+  list l1;
+  list l2;
+  for(i=1;i<=size(v1);i++)
+  {
+    l1[i]=v1[i];
+  }
+  kill i;
+  int k;
+  for(k=1;k<=size(v2);k++)
+  {
+    l2[k]=v2[k];
+  }
+  lresult=l1+l2;
+  intvec result;
+  int j;
+  int counter=1;
+  for(j=1;j<=size(lresult);j++)
+  {
+    if(lresult[j]!=0)
+    {
+      result[counter]=lresult[j];
+      counter++;
+    }
+  }
+  return(result);
+
+}
+/////////////////////////////////////////////////
+static proc intveclist(intvec v)
+//////returns the intvec as list
+{
+  list l;
+  int i;
+  for(i=size(v);i>=1;i--)
+  {
+    l[i]=v[i];
+  }
+  return(l);
+}
+//////////////////////////////////////////////////
+static proc listintvec(list l)
+//////////returns the list as intvec: only integer-entries allowed
+{
+  intvec v;
+  int i;
+  for(i=size(l);i>=1;i--)
+  {
+    v[i]=l[i];
+  }
+  return(v);
+}
+//////////////////////////////////////////////////
+static proc TestAndDelete(string str, string booleansign)
+{
+  int decide=find(str,booleansign);
+  intvec v;
+  v[1]=decide;
+  while(decide!=0 and decide<size(str))//if booleansign ist not contained in str
+  {
+    int n=size(v);
+    decide=find(str,booleansign,decide+1);
+    if(decide!=0)
+    {
+      v[n+1]=decide;
+    }
+    kill n;
+  }
+  if(size(v)==1 and v[1]==0)/////i.e. booleansign NOT in str
+  {
+    list result=str,v;
+    return(result);
+  }
+  else
+  {
+    list l;
+    string p;
+    int i;
+    int j;
+    for(i=1;i<=size(str);i++)///copy the string str into l
+    {
+      l[i]=str[i];
+    }
+    kill i;
+    for(j=1;j<=size(v);j++)///replace booleansign by empty char
+    {
+      int k;
+      for(k=0;k<=size(booleansign)-1;k++)
+      {
+        l[v[j]+k]=" ";
+      }
+      kill k;
+    }
+    int s;
+    for(s=1;s<=size(l);s++)///copy back
+    {
+      p=p+string(l[s]);
+    }
+    kill s;
+    kill l;
+    list result=p,v;
+    return(result);
+  }
+}
+//////////////////////////////////////////////////
+static proc nchoice(int n1,int n2)
+{
+  int N2=maximal(n1,n2);
+  int N1=minimal(n1,n2);
+  if(N1==0)
+  {
+    return(N2);
+  }
+  else
+  {
+    return(N1);
+  }
+}