Index: Singular/LIB/primdec.lib
===================================================================
--- Singular/LIB/primdec.lib	(revision 70ab7345177754da28df06fc80c572286ed3e7ee)
+++ Singular/LIB/primdec.lib	(revision a36e78f7f85445e5816d564f9ea8214033537fad)
@@ -1,4 +1,4 @@
 ///////////////////////////////////////////////////////////////////////////////
-version="$Id: primdec.lib,v 1.130 2007-03-20 17:31:37 Singular Exp $";
+version="$Id: primdec.lib,v 1.131 2007-03-21 15:39:12 Singular Exp $";
 category="Commutative Algebra";
 info="
@@ -226,5 +226,4 @@
       g=1;
       verg=laedi;
-
       for(j=1;j<=size(fac);j++)
       {
@@ -234,5 +233,4 @@
         }
       }
-
       verg=quotient(laedi,g);
 
@@ -677,5 +675,4 @@
               l[2*i]=maxideal(1);
             }
-
             i--;
             break;
@@ -954,5 +951,5 @@
       if((act[2][@k]==1)&&(vdim(primary[2*@k-1])==deg(act[1][@k])))
       {
-        primary[2*@k] = primary[2*@k-1];
+        primary[2*@k]   = primary[2*@k-1];
       }
       else
@@ -1076,5 +1073,5 @@
             {
               jmap1[zz]=-1/leadcoef(primary[2*@k-1][@n])*primary[2*@k-1][@n]
-                  +2/leadcoef(primary[2*@k-1][@n])*lead(primary[2*@k-1][@n]);
+                   +2/leadcoef(primary[2*@k-1][@n])*lead(primary[2*@k-1][@n]);
               jmap2[zz]=primary[2*@k-1][@n];
               @qht[@n]=var(zz);
@@ -1164,5 +1161,5 @@
       if(size(lres0)==2)
       {
-        lres0[2]=groebner(lres0[2],"par2var");
+        lres0[2]=groebner(lres0[2]);
       }
       else
@@ -1172,5 +1169,5 @@
           if(specialIdealsEqual(lres0[2*@n-1],lres0[2*@n])==1)
           {
-            lres0[2*@n-1]=groebner(lres0[2*@n-1],"par2var");
+            lres0[2*@n-1]=groebner(lres0[2*@n-1]);
             lres0[2*@n]=lres0[2*@n-1];
             attrib(lres0[2*@n],"isSB",1);
@@ -1178,6 +1175,6974 @@
           else
           {
-            lres0[2*@n-1]=groebner(lres0[2*@n-1],"par2var");
-            lres0[2*@n]=groebner(lres0[2*@n],"par2var");
+            lres0[2*@n-1]=groebner(lres0[2*@n-1]);
+            lres0[2*@n]=groebner(lres0[2*@n]);
+          }
+        }
+      }
+      primary=primary+lres0;
+
+//=============================================================
+//       if(npars(@P)>0)
+//       {
+//          @ri= "ring @Phelp ="
+//                  +string(char(@P))+",
+//                   ("+varstr(@P)+","+parstr(@P)+",@t),(C,dp);";
+//       }
+//       else
+//       {
+//          @ri= "ring @Phelp ="
+//                  +string(char(@P))+",("+varstr(@P)+",@t),(C,dp);";
+//       }
+//       execute(@ri);
+//       list @lvec;
+//       list @lr=imap(@P,lres0);
+//       ideal @lr1;
+//
+//       if(size(@lr)==2)
+//       {
+//          @lr[2]=homog(@lr[2],@t);
+//          @lr1=std(@lr[2]);
+//          @lvec[2]=hilb(@lr1,1);
+//       }
+//       else
+//       {
+//          for(@n=1;@n<=size(@lr)/2;@n++)
+//          {
+//             if(specialIdealsEqual(@lr[2*@n-1],@lr[2*@n])==1)
+//             {
+//                @lr[2*@n-1]=homog(@lr[2*@n-1],@t);
+//                @lr1=std(@lr[2*@n-1]);
+//                @lvec[2*@n-1]=hilb(@lr1,1);
+//                @lvec[2*@n]=@lvec[2*@n-1];
+//             }
+//             else
+//             {
+//                @lr[2*@n-1]=homog(@lr[2*@n-1],@t);
+//                @lr1=std(@lr[2*@n-1]);
+//                @lvec[2*@n-1]=hilb(@lr1,1);
+//                @lr[2*@n]=homog(@lr[2*@n],@t);
+//                @lr1=std(@lr[2*@n]);
+//                @lvec[2*@n]=hilb(@lr1,1);
+//
+//             }
+//         }
+//       }
+//       @ri= "ring @Phelp1 ="
+//                  +string(char(@P))+",("+varstr(@Phelp)+"),(C,lp);";
+//       execute(@ri);
+//       list @lr=imap(@Phelp,@lr);
+//
+//       kill @Phelp;
+//       if(size(@lr)==2)
+//      {
+//          @lr[2]=std(@lr[2],@lvec[2]);
+//          @lr[2]=subst(@lr[2],@t,1);
+//       }
+//       else
+//       {
+//          for(@n=1;@n<=size(@lr)/2;@n++)
+//          {
+//             if(specialIdealsEqual(@lr[2*@n-1],@lr[2*@n])==1)
+//             {
+//                @lr[2*@n-1]=std(@lr[2*@n-1],@lvec[2*@n-1]);
+//                @lr[2*@n-1]=subst(@lr[2*@n-1],@t,1);
+//                @lr[2*@n]=@lr[2*@n-1];
+//                attrib(@lr[2*@n],"isSB",1);
+//             }
+//             else
+//             {
+//                @lr[2*@n-1]=std(@lr[2*@n-1],@lvec[2*@n-1]);
+//                @lr[2*@n-1]=subst(@lr[2*@n-1],@t,1);
+//                @lr[2*@n]=std(@lr[2*@n],@lvec[2*@n]);
+//                @lr[2*@n]=subst(@lr[2*@n],@t,1);
+//             }
+//          }
+//       }
+//       kill @lvec;
+//       setring @P;
+//       lres0=imap(@Phelp1,@lr);
+//       kill @Phelp1;
+//       for(@n=1;@n<=size(lres0);@n++)
+//       {
+//          lres0[@n]=clearSB(lres0[@n]);
+//          attrib(lres0[@n],"isSB",1);
+//       }
+//
+//       primary[2*@k-1]=lres0[1];
+//       primary[2*@k]=lres0[2];
+//       @s=size(primary)/2;
+//       for(@n=1;@n<=size(lres0)/2-1;@n++)
+//       {
+//         primary[2*@s+2*@n-1]=lres0[2*@n+1];
+//         primary[2*@s+2*@n]=lres0[2*@n+2];
+//       }
+//       @k--;
+//=============================================================
+    }
+  }
+  return(primary);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring  r = 0,(x,y,z),lp;
+   poly  p = z2+1;
+   poly  q = z4+2;
+   ideal i = p^2*q^3,(y-z3)^3,(x-yz+z4)^4;
+   i=std(i);
+   list  pr= zero_decomp(i,ideal(0),0);
+   pr;
+}
+///////////////////////////////////////////////////////////////////////////////
+proc extF(list l,list #)
+{
+//zero_dimensional primary decomposition after finite field extension
+  def R=basering;
+  int p=char(R);
+
+  if((p==0)||(p>13)||(npars(R)>0)){return(l);}
+
+  int ex=3;
+  if(size(#)>0){ex=#[1];}
+
+  list peek,peek1;
+  while(size(l)>0)
+  {
+    if(size(l[2])==0)
+    {
+      peek[size(peek)+1]=l[1];
+    }
+    else
+    {
+      peek1[size(peek1)+1]=l[1];
+      peek1[size(peek1)+1]=l[2];
+    }
+    l=delete(l,1);
+    l=delete(l,1);
+  }
+  if(size(peek)==0){return(peek1);}
+
+  string gnir="ring RH=("+string(p)+"^"+string(ex)+",a),("+varstr(R)+"),lp;";
+  execute(gnir);
+  string mp="minpoly="+string(minpoly)+";";
+  gnir="ring RL=("+string(p)+",a),("+varstr(R)+"),lp;";
+  execute(gnir);
+  execute(mp);
+  list L=imap(R,peek);
+  list pr, keep;
+  int i;
+  for(i=1;i<=size(L);i++)
+  {
+    attrib(L[i],"isSB",1);
+    pr=zero_decomp(L[i],0,0);
+    keep=keep+pr;
+  }
+  for(i=1;i<=size(keep);i++)
+  {
+    keep[i]=simplify(keep[i],1);
+  }
+  mp="poly pp="+string(minpoly)+";";
+
+  string gnir1="ring RS="+string(p)+",("+varstr(R)+",a),lp;";
+  execute(gnir1);
+  execute(mp);
+  list L=imap(RL,keep);
+
+  for(i=1;i<=size(L);i++)
+  {
+    L[i]=eliminate(L[i]+ideal(pp),a);
+  }
+  i=0;
+  int j;
+  while(i<size(L)/2-1)
+  {
+    i++;
+    j=i;
+    while(j<size(L)/2)
+    {
+      j++;
+      if(idealsEqual(L[2*i-1],L[2*j-1]))
+      {
+        L=delete(L,2*j-1);
+        L=delete(L,2*j-1);
+        j--;
+      }
+    }
+  }
+  setring R;
+  list re=imap(RS,L);
+  re=re+peek1;
+
+  return(extF(re,ex+1));
+}
+
+///////////////////////////////////////////////////////////////////////////////
+proc zeroSp(ideal i)
+{
+//preparation for the separable closure
+//decomposition into ideals of special type
+//i.e. the minimal polynomials of every variable mod i are irreducible
+//returns a list of 2 lists: rr=pe,qe
+//the ideals in pe[l] are special, their special elements are in qe[l]
+//pe[l] is a dp-Groebnerbasis
+//the radical of the intersection of the pe[l] is equal to the radical of i
+
+  def R=basering;
+
+  //i has to be a reduced groebner basis
+  ideal F=finduni(i);
+
+  int j,k,l,ready;
+  list fa;
+  fa[1]=factorize(F[1],1);
+  poly te,ti;
+  ideal tj;
+  //avoid factorization of the same polynomial
+  for(j=2;j<=size(F);j++)
+  {
+    for(k=1;k<=j-1;k++)
+    {
+      ti=F[k];
+      te=subst(ti,var(k),var(j));
+      if(te==F[j])
+      {
+        tj=fa[k];
+        fa[j]=subst(tj,var(k),var(j));
+        ready=1;
+        break;
+      }
+    }
+    if(!ready)
+    {
+      fa[j]=factorize(F[j],1);
+    }
+    ready=0;
+  }
+  execute( "ring P=("+charstr(R)+"),("+varstr(R)+"),(C,dp);");
+  ideal i=imap(R,i);
+  if(npars(basering)==0)
+  {
+    ideal J=fglm(R,i);
+  }
+  else
+  {
+    ideal J=groebner(i);
+  }
+  list fa=imap(R,fa);
+  list qe=J;          //collects a dp-Groebnerbasis of the special ideals
+  list keep=ideal(0); //collects the special elements
+
+  list re,em,ke;
+  ideal K,L;
+
+  for(j=1;j<=nvars(basering);j++)
+  {
+    for(l=1;l<=size(qe);l++)
+    {
+      for(k=1;k<=size(fa[j]);k++)
+      {
+        L=std(qe[l],fa[j][k]);
+        K=keep[l],fa[j][k];
+        if(deg(L[1])>0)
+        {
+          re[size(re)+1]=L;
+          ke[size(ke)+1]=K;
+        }
+      }
+    }
+    qe=re;
+    re=em;
+    keep=ke;
+    ke=em;
+  }
+
+  setring R;
+  list qe=imap(P,keep);
+  list pe=imap(P,qe);
+  for(l=1;l<=size(qe);l++)
+  {
+    qe[l]=simplify(qe[l],2);
+  }
+  list rr=pe,qe;
+  return(rr);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc zeroSepClos(ideal I,ideal F)
+{
+//computes the separable closure of the special ideal I
+//F is the set of special elements of I
+//returns the separable closure sc(I) of I and an intvec v
+//such that sc(I)=preimage(frobenius definde by v)
+//i.e. var(i)----->var(i)^(p^v[i])
+
+  if(homog(I)==1){return(maxideal(1));}
+
+  //assume F[i] irreducible in I and depending only on var(i)
+
+  def R=basering;
+  int n=nvars(R);
+  int p=char(R);
+  intvec v;
+  v[n]=0;
+  int i,k;
+  list l;
+
+  for(i=1;i<=n;i++)
+  {
+    l[i]=sep(F[i],i);
+    F[i]=l[i][1];
+    if(l[i][2]>k){k=l[i][2];}
+  }
+
+  if(k==0){return(list(I,v));}        //the separable case
+  ideal m;
+
+  for(i=1;i<=n;i++)
+  {
+    m[i]=var(i)^(p^l[i][2]);
+    v[i]=l[i][2];
+  }
+  map phi=R,m;
+  ideal J=preimage(R,phi,I);
+  return(list(J,v));
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc insepDecomp(ideal i)
+{
+//decomposes i into special ideals
+//computes the prime decomposition of the special ideals
+//and transforms it back to a decomposition of i
+
+  def R=basering;
+  list pr=zeroSp(i);
+  int l,k;
+  list re,wo,qr;
+  ideal m=maxideal(1);
+  ideal K;
+  map phi=R,m;
+  int p=char(R);
+  intvec op=option(get);
+
+  for(l=1;l<=size(pr[1]);l++)
+  {
+    wo=zeroSepClos(pr[1][l],pr[2][l]);
+    for(k=1;k<=nvars(basering);k++)
+    {
+      m[k]=var(k)^(p^wo[2][k]);
+    }
+    phi=R,m;
+    qr=decomp(wo[1],2);
+
+    option(redSB);
+    for(k=1;k<=size(qr)/2;k++)
+    {
+      K=qr[2*k];
+      K=phi(K);
+      K=groebner(K);
+      re[size(re)+1]=zeroRad(K);
+    }
+    option(noredSB);
+  }
+  option(set,op);
+  return(re);
+}
+
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc clearSB (ideal i,list #)
+"USAGE:   clearSB(i); i ideal which is SB ordered by monomial ordering
+RETURN:  ideal = minimal SB
+NOTE:
+EXAMPLE: example clearSB; shows an example
+"
+{
+  int k,j;
+  poly m;
+  int c=size(i);
+
+  if(size(#)==0)
+  {
+    for(j=1;j<c;j++)
+    {
+      if(deg(i[j])==0)
+      {
+        i=ideal(1);
+        return(i);
+      }
+      if(deg(i[j])>0)
+      {
+        m=lead(i[j]);
+        for(k=j+1;k<=c;k++)
+        {
+          if(size(lead(i[k])/m)>0)
+          {
+            i[k]=0;
+          }
+        }
+      }
+    }
+  }
+  else
+  {
+    j=0;
+    while(j<c-1)
+    {
+      j++;
+      if(deg(i[j])==0)
+      {
+        i=ideal(1);
+        return(i);
+      }
+      if(deg(i[j])>0)
+      {
+        m=lead(i[j]);
+        for(k=j+1;k<=c;k++)
+        {
+          if(size(lead(i[k])/m)>0)
+          {
+            if((leadexp(m)!=leadexp(i[k]))||(#[j]<=#[k]))
+            {
+              i[k]=0;
+            }
+            else
+            {
+              i[j]=0;
+              break;
+            }
+          }
+        }
+      }
+    }
+  }
+  return(simplify(i,2));
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring  r = (0,a,b),(x,y,z),dp;
+   ideal i=ax2+y,a2x+y,bx;
+   list l=1,2,1;
+   ideal j=clearSB(i,l);
+   j;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+static proc clearSBNeu (ideal i,list #)
+"USAGE:   clearSB(i); i ideal which is SB ordered by monomial ordering
+RETURN:  ideal = minimal SB
+NOTE:
+EXAMPLE: example clearSB; shows an example
+"
+{
+ int k,j;
+ intvec m,n,v,w;
+ int c=size(i);
+ w=leadexp(0);
+ v[size(i)]=0;
+
+ j=0;
+ while(j<c-1)
+ {
+   j++;
+   if(deg(i[j])>=0)
+   {
+      m=leadexp(i[j]);
+      for(k=j+1;k<=c;k++)
+      {
+        n=leadexp(i[k]);
+        if(n!=w)
+        {
+           if(((m==n)&&(#[j]>#[k]))||((teilt(n,m))&&(n!=m)))
+           {
+             i[j]=0;
+             v[j]=1;
+             break;
+           }
+           if(((m==n)&&(#[j]<=#[k]))||((teilt(m,n))&&(n!=m)))
+           {
+             i[k]=0;
+             v[k]=1;
+           }
+        }
+      }
+    }
+  }
+  return(v);
+}
+
+static proc teilt(intvec a, intvec b)
+{
+  int i;
+  for(i=1;i<=size(a);i++)
+  {
+    if(a[i]>b[i]){return(0);}
+  }
+  return(1);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+static proc independSet (ideal j)
+"USAGE:   independentSet(i); i ideal
+RETURN:  list = new varstring with the independent set at the end,
+                ordstring with the corresponding block ordering,
+                the integer where the independent set starts in the varstring
+NOTE:
+EXAMPLE: example independentSet; shows an example
+"
+{
+  int n,k,di;
+  list resu,hilf;
+  string var1,var2;
+  list v=indepSet(j,1);
+
+  for(n=1;n<=size(v);n++)
+  {
+    di=0;
+    var1="";
+    var2="";
+    for(k=1;k<=size(v[n]);k++)
+    {
+      if(v[n][k]!=0)
+      {
+        di++;
+        var2=var2+"var("+string(k)+"),";
+      }
+      else
+      {
+        var1=var1+"var("+string(k)+"),";
+      }
+    }
+    if(di>0)
+    {
+      var1=var1+var2;
+      var1=var1[1..size(var1)-1];
+      hilf[1]=var1;
+      hilf[2]="lp";
+      //"lp("+string(nvars(basering)-di)+"),dp("+string(di)+")";
+      hilf[3]=di;
+      resu[n]=hilf;
+    }
+    else
+    {
+      resu[n]=varstr(basering),ordstr(basering),0;
+    }
+  }
+  return(resu);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring s1=(0,x,y),(a,b,c,d,e,f,g),lp;
+   ideal i=ea-fbg,fa+be,ec-fdg,fc+de;
+   i=std(i);
+   list  l=independSet(i);
+   l;
+   i=i,g;
+   l=independSet(i);
+   l;
+
+   ring s=0,(x,y,z),lp;
+   ideal i=z,yx;
+   list l=independSet(i);
+   l;
+
+
+}
+///////////////////////////////////////////////////////////////////////////////
+
+static proc maxIndependSet (ideal j)
+"USAGE:   maxIndependentSet(i); i ideal
+RETURN:  list = new varstring with the maximal independent set at the end,
+                ordstring with the corresponding block ordering,
+                the integer where the independent set starts in the varstring
+NOTE:
+EXAMPLE: example maxIndependentSet; shows an example
+"
+{
+  int n,k,di;
+  list resu,hilf;
+  string var1,var2;
+  list v=indepSet(j,0);
+
+  for(n=1;n<=size(v);n++)
+  {
+    di=0;
+    var1="";
+    var2="";
+    for(k=1;k<=size(v[n]);k++)
+    {
+      if(v[n][k]!=0)
+      {
+        di++;
+        var2=var2+"var("+string(k)+"),";
+      }
+      else
+      {
+        var1=var1+"var("+string(k)+"),";
+      }
+    }
+    if(di>0)
+    {
+      var1=var1+var2;
+      var1=var1[1..size(var1)-1];
+      hilf[1]=var1;
+      hilf[2]="lp";
+      hilf[3]=di;
+      resu[n]=hilf;
+    }
+    else
+    {
+      resu[n]=varstr(basering),ordstr(basering),0;
+    }
+  }
+  return(resu);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring s1=(0,x,y),(a,b,c,d,e,f,g),lp;
+   ideal i=ea-fbg,fa+be,ec-fdg,fc+de;
+   i=std(i);
+   list  l=maxIndependSet(i);
+   l;
+   i=i,g;
+   l=maxIndependSet(i);
+   l;
+
+   ring s=0,(x,y,z),lp;
+   ideal i=z,yx;
+   list l=maxIndependSet(i);
+   l;
+
+
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc prepareQuotientring (int nnp)
+"USAGE:   prepareQuotientring(nnp); nnp int
+RETURN:  string = to define Kvar(nnp+1),...,var(nvars)[..rest ]
+NOTE:
+EXAMPLE: example independentSet; shows an example
+"
+{
+  ideal @ih,@jh;
+  int npar=npars(basering);
+  int @n;
+
+  string quotring= "ring quring = ("+charstr(basering);
+  for(@n=nnp+1;@n<=nvars(basering);@n++)
+  {
+     quotring=quotring+",var("+string(@n)+")";
+     @ih=@ih+var(@n);
+  }
+
+  quotring=quotring+"),(var(1)";
+  @jh=@jh+var(1);
+  for(@n=2;@n<=nnp;@n++)
+  {
+    quotring=quotring+",var("+string(@n)+")";
+    @jh=@jh+var(@n);
+  }
+  quotring=quotring+"),(C,lp);";
+
+  return(quotring);
+
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring s1=(0,x),(a,b,c,d,e,f,g),lp;
+   def @Q=basering;
+   list l= prepareQuotientring(3);
+   l;
+   execute(l[1]);
+   execute(l[2]);
+   basering;
+   phi;
+   setring @Q;
+
+}
+
+///////////////////////////////////////////////////////////////////////////////
+static proc cleanPrimary(list l)
+{
+   int i,j;
+   list lh;
+   for(i=1;i<=size(l)/2;i++)
+   {
+      if(deg(l[2*i-1][1])>0)
+      {
+         j++;
+         lh[j]=l[2*i-1];
+         j++;
+         lh[j]=l[2*i];
+      }
+   }
+   return(lh);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+
+proc minAssPrimesold(ideal i, list #)
+"USAGE:   minAssPrimes(i); i ideal
+         minAssPrimes(i,1); i ideal  (to use also the factorizing Groebner)
+RETURN:  list = the minimal associated prime ideals of i
+EXAMPLE: example minAssPrimes; shows an example
+"
+{
+   def @P=basering;
+   if(size(i)==0){return(list(ideal(0)));}
+   list qr=simplifyIdeal(i);
+   map phi=@P,qr[2];
+   i=qr[1];
+
+   execute ("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),("
+             +ordstr(basering)+");");
+
+
+   ideal i=fetch(@P,i);
+   if(size(#)==0)
+   {
+      int @wr;
+      list tluser,@res;
+      list primary=decomp(i,2);
+
+      @res[1]=primary;
+
+      tluser=union(@res);
+      setring @P;
+      list @res=imap(gnir,tluser);
+      return(phi(@res));
+   }
+   list @res,empty;
+   ideal ser;
+   option(redSB);
+   list @pr=facstd(i);
+   //if(size(@pr)==1)
+//   {
+//      attrib(@pr[1],"isSB",1);
+//      if((dim(@pr[1])==0)&&(homog(@pr[1])==1))
+//      {
+//         setring @P;
+//         list @res=maxideal(1);
+//         return(phi(@res));
+//      }
+//      if(dim(@pr[1])>1)
+//      {
+//         setring @P;
+//        // kill gnir;
+//         execute ("ring gnir1 = ("+charstr(basering)+"),
+//                              ("+varstr(basering)+"),(C,lp);");
+//         ideal i=fetch(@P,i);
+//         list @pr=facstd(i);
+//        // ideal ser;
+//         setring gnir;
+//         @pr=fetch(gnir1,@pr);
+//         kill gnir1;
+//      }
+//   }
+    option(noredSB);
+   int j,k,odim,ndim,count;
+   attrib(@pr[1],"isSB",1);
+   if(#[1]==77)
+   {
+     odim=dim(@pr[1]);
+     count=1;
+     intvec pos;
+     pos[size(@pr)]=0;
+     for(j=2;j<=size(@pr);j++)
+     {
+        attrib(@pr[j],"isSB",1);
+        ndim=dim(@pr[j]);
+        if(ndim>odim)
+        {
+           for(k=count;k<=j-1;k++)
+           {
+              pos[k]=1;
+           }
+           count=j;
+           odim=ndim;
+        }
+        if(ndim<odim)
+        {
+           pos[j]=1;
+        }
+     }
+     for(j=1;j<=size(@pr);j++)
+     {
+        if(pos[j]!=1)
+        {
+            @res[j]=decomp(@pr[j],2);
+        }
+        else
+        {
+           @res[j]=empty;
+        }
+     }
+   }
+   else
+   {
+     ser=ideal(1);
+     for(j=1;j<=size(@pr);j++)
+     {
+//@pr[j];
+//pause();
+        @res[j]=decomp(@pr[j],2);
+//       @res[j]=decomp(@pr[j],2,@pr[j],ser);
+//       for(k=1;k<=size(@res[j]);k++)
+//       {
+//          ser=intersect(ser,@res[j][k]);
+//       }
+     }
+   }
+
+   @res=union(@res);
+   setring @P;
+   list @res=imap(gnir,@res);
+   return(phi(@res));
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring  r = 32003,(x,y,z),lp;
+   poly  p = z2+1;
+   poly  q = z4+2;
+   ideal i = p^2*q^3,(y-z3)^3,(x-yz+z4)^4;
+   list pr= minAssPrimes(i);  pr;
+
+   minAssPrimes(i,1);
+}
+
+static proc primT(ideal i)
+{
+   //assumes that all generators of i are irreducible
+   //i is standard basis
+
+   attrib(i,"isSB",1);
+   int j=size(i);
+   int k;
+   while(j>0)
+   {
+     if(deg(i[j])>1){break;}
+     j--;
+   }
+   if(j==0){return(1);}
+   if(deg(i[j])==vdim(i)){return(1);}
+   return(0);
+}
+
+static proc minAssPrimes(ideal i, list #)
+"USAGE:   minAssPrimes(i); i ideal
+      Optional parameters in list #: (can be entered in any order)
+      0, "facstd"   ->   uses facstd to first decompose the ideal
+      1, "noFacstd" ->  does not use facstd (default)
+      "SL" ->     the new algorithm is used (default)
+      "GTZ" ->     the old algorithm is used
+RETURN:  list = the minimal associated prime ideals of i
+EXAMPLE: example minAssPrimes; shows an example
+"
+{
+  if(size(i) == 0){return(list(ideal(0)));}
+  string algorithm;    // Algorithm to be used
+  string facstdOption;    // To uses proc facstd
+  int j;          // Counter
+  def P0 = basering;
+  list Pl=ringlist(P0);
+  intvec dp_w;
+  for(j=nvars(P0);j>0;j--) {dp_w[j]=1;}
+  Pl[3]=list(list("dp",dp_w),list("C",0));
+  def P=ring(Pl);
+  setring P;
+  ideal i=imap(P0,i);
+
+  // Set input parameters
+  algorithm = "SL";         // Default: SL algorithm
+  facstdOption = "noFacstd";    // Default: facstd is not used
+  if(size(#) > 0)
+  {
+    int valid;
+    for(j = 1; j <= size(#); j++)
+    {
+      valid = 0;
+      if((typeof(#[j]) == "int") or (typeof(#[j]) == "number"))
+      {
+        if (#[j] == 0) {facstdOption = "noFacstd"; valid = 1;}    // If #[j] == 0, facstd is not used.
+        if (#[j] == 1) {facstdOption = "facstd";   valid = 1;}    // If #[j] == 1, facstd is used.
+      }
+      if(typeof(#[j]) == "string")
+      {
+        if(#[j] == "GTZ" || #[j] == "SL")
+        {
+          algorithm = #[j];
+          valid = 1;
+        }
+        if(#[j] == "noFacstd" || #[j] == "facstd")
+        {
+          facstdOption = #[j];
+          valid = 1;
+        }
+      }
+      if(valid == 0)
+      {
+        dbprint(1, "Warning! The following input parameter was not recognized:", #[j]);
+      }
+    }
+  }
+
+  list q = simplifyIdeal(i);
+  list re = maxideal(1);
+  int a, k;
+  intvec op = option(get);
+  map phi = P,q[2];
+
+  list result;
+
+  if(npars(P) == 0){option(redSB);}
+
+  if(attrib(i,"isSB")!=1)
+  {
+    i=groebner(q[1]);
+  }
+  else
+  {
+    for(j=1;j<=nvars(basering);j++)
+    {
+      if(q[2][j]!=var(j)){k=1;break;}
+    }
+    if(k)
+    {
+      i=groebner(q[1]);
+    }
+  }
+
+  if(dim(i) == -1){setring P0;return(ideal(1));}
+  if((dim(i) == 0) && (npars(P) == 0))
+  {
+    int di = vdim(i);
+    execute ("ring gnir=("+charstr(P)+"),("+varstr(P)+"),lp;");
+    ideal J = std(imap(P,i));
+    attrib(J, "isSB", 1);
+    if(vdim(J) != di)
+    {
+      J = fglm(P, i);
+    }
+    list pr = triangMH(J, 2);
+    list qr, re;
+
+    for(k = 1; k <= size(pr); k++)
+    {
+      if(primT(pr[k]))
+      {
+        re[size(re) + 1] = pr[k];
+      }
+      else
+      {
+        attrib(pr[k], "isSB", 1);
+        // Lines changed
+        if (algorithm == "GTZ")
+        {
+          qr = decomp(pr[k], 2);
+        }
+        else
+        {
+          qr = minAssSL(pr[k]);
+        }
+        for(j = 1; j <= size(qr) / 2; j++)
+        {
+          re[size(re) + 1] = qr[2 * j];
+        }
+      }
+    }
+    setring P;
+    re = imap(gnir, re);
+    re=phi(re);
+    option(set, op);
+    setring(P0);
+    list re=imap(P,re);
+    return(re);
+  }
+
+  // Lines changed
+  if ((facstdOption == "noFacstd") || (dim(i) == 0))
+  {
+    if (algorithm == "GTZ")
+    {
+      re[1] = decomp(i, 2);
+    }
+    else
+    {
+      re[1] = minAssSL(i);
+    }
+    re = union(re);
+    option(set, op);
+    re=phi(re);
+    setring(P0);
+    list re=imap(P,re);
+    return(re);
+  }
+  q = facstd(i);
+
+/*
+  if((size(q) == 1) && (dim(i) > 1))
+  {
+    execute ("ring gnir=("+charstr(P)+"),("+varstr(P)+"),lp;");
+    list p = facstd(fetch(P, i));
+    if(size(p) > 1)
+    {
+      a = 1;
+      setring P;
+      q = fetch(gnir,p);
+    }
+    else
+    {
+      setring P;
+    }
+    kill gnir;
+  }
+*/
+  option(set,op);
+  // Debug
+  dbprint(printlevel - voice, "Components returned by facstd", size(q), q);
+  for(j = 1; j <= size(q); j++)
+  {
+    if(a == 0){attrib(q[j], "isSB", 1);}
+    // Debug
+    dbprint(printlevel - voice, "We compute the decomp of component", j);
+    // Lines changed
+    if (algorithm == "GTZ")
+    {
+      re[j] = decomp(q[j], 2);
+    }
+    else
+    {
+      re[j] = minAssSL(q[j]);
+    }
+    // Debug
+    dbprint(printlevel - voice, "Number of components obtained for this component:", size(re[j]) / 2);
+    dbprint(printlevel - voice, "re[j]:", re[j]);
+  }
+  re = union(re);
+  re=phi(re);
+  setring(P0);
+  list re=imap(P,re);
+  return(re);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring  r = 32003,(x,y,z),lp;
+   poly  p = z2+1;
+   poly  q = z4+2;
+   ideal i = p^2*q^3,(y-z3)^3,(x-yz+z4)^4;
+   list pr= minAssPrimes(i);  pr;
+
+   minAssPrimes(i,1);
+}
+
+static proc union(list li)
+{
+  int i,j,k;
+
+  def P=basering;
+
+  execute("ring ir = ("+charstr(basering)+"),("+varstr(basering)+"),(C,lp);");
+  list l=fetch(P,li);
+  list @erg;
+
+  for(k=1;k<=size(l);k++)
+  {
+     for(j=1;j<=size(l[k])/2;j++)
+     {
+        if(deg(l[k][2*j][1])!=0)
+        {
+           i++;
+           @erg[i]=l[k][2*j];
+        }
+     }
+  }
+
+  list @wos;
+  i=0;
+  ideal i1,i2;
+  while(i<size(@erg)-1)
+  {
+     i++;
+     k=i+1;
+     i1=lead(@erg[i]);
+      attrib(i1,"isSB",1);
+      attrib(@erg[i],"isSB",1);
+
+     while(k<=size(@erg))
+     {
+        if(deg(@erg[i][1])==0)
+        {
+           break;
+        }
+        i2=lead(@erg[k]);
+        attrib(@erg[k],"isSB",1);
+        attrib(i2,"isSB",1);
+
+        if(size(reduce(i1,i2,1))==0)
+        {
+           if(size(reduce(@erg[i],@erg[k],1))==0)
+           {
+              @erg[k]=ideal(1);
+              i2=ideal(1);
+           }
+        }
+        if(size(reduce(i2,i1,1))==0)
+        {
+           if(size(reduce(@erg[k],@erg[i],1))==0)
+           {
+              break;
+           }
+        }
+        k++;
+        if(k>size(@erg))
+        {
+           @wos[size(@wos)+1]=@erg[i];
+        }
+     }
+  }
+  if(deg(@erg[size(@erg)][1])!=0)
+  {
+     @wos[size(@wos)+1]=@erg[size(@erg)];
+  }
+  setring P;
+  list @ser=fetch(ir,@wos);
+  return(@ser);
+}
+///////////////////////////////////////////////////////////////////////////////
+proc equidim(ideal i,list #)
+"USAGE:  equidim(i) or equidim(i,1) ; i ideal
+RETURN: list of equidimensional ideals a[1],...,a[s] with:
+        - a[s] the equidimensional locus of i, i.e. the intersection
+          of the primary ideals of dimension of i
+        - a[1],...,a[s-1] the lower dimensional equidimensional loci.
+NOTE:    An embedded component q (primary ideal) of i can be replaced in the
+         decomposition by a primary ideal q1 with the same radical as q. @*
+         @code{equidim(i,1)} uses the algorithm of Eisenbud/Huneke/Vasconcelos.
+
+EXAMPLE:example equidim; shows an example
+"
+{
+  if(attrib(basering,"global")!=1)
+  {
+      ERROR(
+      "// Not implemented for this ordering, please change to global ordering."
+      );
+  }
+  intvec op ;
+  def  P = basering;
+  list eq;
+  intvec w;
+  int n,m;
+  int g=size(i);
+  int a=attrib(i,"isSB");
+  int homo=homog(i);
+  if(size(#)!=0)
+  {
+     m=1;
+  }
+
+  if(((homo==1)||(a==1))&&(find(ordstr(basering),"l")==0)
+                                &&(find(ordstr(basering),"s")==0))
+  {
+     execute("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),("
+                              +ordstr(basering)+");");
+     ideal i=imap(P,i);
+     ideal j=i;
+     if(a==1)
+     {
+       attrib(j,"isSB",1);
+     }
+     else
+     {
+       j=groebner(i);
+     }
+  }
+  else
+  {
+     execute("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),dp;");
+     ideal i=imap(P,i);
+     ideal j=groebner(i);
+  }
+  if(homo==1)
+  {
+     for(n=1;n<=nvars(basering);n++)
+     {
+        w[n]=ord(var(n));
+     }
+     intvec hil=hilb(j,1,w);
+  }
+
+  if ((dim(j)==-1)||(size(j)==0)||(nvars(basering)==1)
+                  ||(dim(j)==0)||(dim(j)+g==nvars(basering)))
+  {
+    setring P;
+    eq[1]=i;
+    return(eq);
+  }
+
+  if(m==0)
+  {
+     ideal k=equidimMax(j);
+  }
+  else
+  {
+     ideal k=equidimMaxEHV(j);
+  }
+  if(size(reduce(k,j,1))==0)
+  {
+    setring P;
+    eq[1]=i;
+    kill gnir;
+    return(eq);
+  }
+  op=option(get);
+  option(returnSB);
+  j=quotient(j,k);
+  option(set,op);
+
+  list equi=equidim(j);
+  if(deg(equi[size(equi)][1])<=0)
+  {
+      equi[size(equi)]=k;
+  }
+  else
+  {
+    equi[size(equi)+1]=k;
+  }
+  setring P;
+  eq=imap(gnir,equi);
+  kill gnir;
+  return(eq);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring  r = 32003,(x,y,z),dp;
+   ideal i = intersect(ideal(z),ideal(x,y),ideal(x2,z2),ideal(x5,y5,z5));
+   equidim(i);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+proc equidimMax(ideal i)
+"USAGE:  equidimMax(i); i ideal
+RETURN:  ideal of equidimensional locus (of maximal dimension) of i.
+EXAMPLE: example equidimMax; shows an example
+"
+{
+  if(attrib(basering,"global")!=1)
+  {
+      ERROR(
+      "// Not implemented for this ordering, please change to global ordering."
+      );
+  }
+  def  P = basering;
+  ideal eq;
+  intvec w;
+  int n;
+  int g=size(i);
+  int a=attrib(i,"isSB");
+  int homo=homog(i);
+
+  if(((homo==1)||(a==1))&&(find(ordstr(basering),"l")==0)
+                                &&(find(ordstr(basering),"s")==0))
+  {
+     execute("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),("
+                              +ordstr(basering)+");");
+     ideal i=imap(P,i);
+     ideal j=i;
+     if(a==1)
+     {
+       attrib(j,"isSB",1);
+     }
+     else
+     {
+       j=groebner(i);
+     }
+  }
+  else
+  {
+     execute("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),dp;");
+     ideal i=imap(P,i);
+     ideal j=groebner(i);
+  }
+  list indep;
+  ideal equ,equi;
+  if(homo==1)
+  {
+     for(n=1;n<=nvars(basering);n++)
+     {
+        w[n]=ord(var(n));
+     }
+     intvec hil=hilb(j,1,w);
+  }
+  if ((dim(j)==-1)||(size(j)==0)||(nvars(basering)==1)
+                  ||(dim(j)==0)||(dim(j)+g==nvars(basering)))
+  {
+    setring P;
+    return(i);
+  }
+
+  indep=maxIndependSet(j);
+
+  execute("ring gnir1 = ("+charstr(basering)+"),("+indep[1][1]+"),("
+                              +indep[1][2]+");");
+  if(homo==1)
+  {
+     ideal j=std(imap(gnir,j),hil,w);
+  }
+  else
+  {
+     ideal j=groebner(imap(gnir,j));
+  }
+  string quotring=prepareQuotientring(nvars(basering)-indep[1][3]);
+  execute(quotring);
+  ideal j=imap(gnir1,j);
+  kill gnir1;
+  j=clearSB(j);
+  ideal h;
+  for(n=1;n<=size(j);n++)
+  {
+     h[n]=leadcoef(j[n]);
+  }
+  setring gnir;
+  ideal h=imap(quring,h);
+  kill quring;
+
+  list l=minSat(j,h);
+
+  if(deg(l[2])>0)
+  {
+    equ=l[1];
+    attrib(equ,"isSB",1);
+    j=std(j,l[2]);
+
+    if(dim(equ)==dim(j))
+    {
+      equi=equidimMax(j);
+      equ=interred(intersect(equ,equi));
+    }
+  }
+  else
+  {
+    equ=i;
+  }
+
+  setring P;
+  eq=imap(gnir,equ);
+  kill gnir;
+  return(eq);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring  r = 32003,(x,y,z),dp;
+   ideal i = intersect(ideal(z),ideal(x,y),ideal(x2,z2),ideal(x5,y5,z5));
+   equidimMax(i);
+}
+///////////////////////////////////////////////////////////////////////////////
+static proc islp()
+{
+   string s=ordstr(basering);
+   int n=find(s,"lp");
+   if(!n){return(0);}
+   int k=find(s,",");
+   string t=s[k+1..size(s)];
+   int l=find(t,",");
+   t=s[1..k-1];
+   int m=find(t,",");
+   if(l+m){return(0);}
+   return(1);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc algeDeco(ideal i, int w)
+{
+//reduces primery decomposition over algebraic extensions to
+//the other cases
+   def R=basering;
+   int n=nvars(R);
+
+//---Anfang Provisorium
+   if((size(i)==2) && (w==2))
+   {
+      option(redSB);
+      ideal J=std(i);
+      option(noredSB);
+      if((size(J)==2)&&(deg(J[1])==1))
+      {
+         ideal keep;
+         poly f;
+         int j;
+         for(j=1;j<=nvars(basering);j++)
+         {
+           f=J[2];
+           while((f/var(j))*var(j)-f==0)
+           {
+             f=f/var(j);
+             keep=keep,var(j);
+           }
+           J[2]=f;
+         }
+         ideal K=factorize(J[2],1);
+         if(deg(K[1])==0){K=0;}
+         K=K+std(keep);
+         ideal L;
+         list resu;
+         for(j=1;j<=size(K);j++)
+         {
+            L=J[1],K[j];
+            resu[j]=L;
+         }
+         return(resu);
+      }
+   }
+//---Ende Provisorium
+   string mp="poly p="+string(minpoly)+";";
+   string gnir="ring RH="+string(char(R))+",("+varstr(R)+","+string(par(1))
+                +"),dp;";
+   execute(gnir);
+   execute(mp);
+   ideal i=imap(R,i);
+   ideal I=subst(i,var(nvars(basering)),0);
+   int j;
+   for(j=1;j<=ncols(i);j++)
+   {
+     if(i[j]!=I[j]){break;}
+   }
+   if((j>ncols(i))&&(deg(p)==1))
+   {
+     setring R;
+     kill RH;
+     kill gnir;
+     string gnir="ring RH="+string(char(R))+",("+varstr(R)+"),dp;";
+     execute(gnir);
+     ideal i=imap(R,i);
+     ideal J;
+   }
+   else
+   {
+      i=i,p;
+   }
+   list pr;
+
+   if(w==0)
+   {
+      pr=decomp(i);
+   }
+   if(w==1)
+   {
+      pr=prim_dec(i,1);
+      pr=reconvList(pr);
+   }
+   if(w==2)
+   {
+      pr=minAssPrimes(i);
+   }
+   if(n<nvars(basering))
+   {
+      gnir="ring RS="+string(char(R))+",("+varstr(RH)
+                +"),(dp("+string(n)+"),lp);";
+      execute(gnir);
+      list pr=imap(RH,pr);
+      ideal K;
+      for(j=1;j<=size(pr);j++)
+      {
+         K=groebner(pr[j]);
+         K=K[2..size(K)];
+         pr[j]=K;
+      }
+      setring R;
+      list pr=imap(RS,pr);
+   }
+   else
+   {
+      setring R;
+      list pr=imap(RH,pr);
+   }
+   list re;
+   if(w==2)
+   {
+      re=pr;
+   }
+   else
+   {
+      re=convList(pr);
+   }
+   return(re);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+static proc decomp(ideal i,list #)
+"USAGE:  decomp(i); i ideal  (for primary decomposition)   (resp.
+         decomp(i,1);        (for the associated primes of dimension of i) )
+         decomp(i,2);        (for the minimal associated primes) )
+         decomp(i,3);        (for the absolute primary decomposition) )
+RETURN:  list = list of primary ideals and their associated primes
+         (at even positions in the list)
+         (resp. a list of the minimal associated primes)
+NOTE:    Algorithm of Gianni/Trager/Zacharias
+EXAMPLE: example decomp; shows an example
+"
+{
+  intvec op,@vv;
+  def  @P = basering;
+  list primary,indep,ltras;
+  intvec @vh,isat,@w;
+  int @wr,@k,@n,@m,@n1,@n2,@n3,homo,seri,keepdi,abspri,ab,nn;
+  ideal peek=i;
+  ideal ser,tras;
+  int isS=(attrib(i,"isSB")==1);
+
+
+  if(size(#)>0)
+  {
+     if((#[1]==1)||(#[1]==2)||(#[1]==3))
+     {
+        @wr=#[1];
+        if(@wr==3){abspri=1;@wr=0;}
+        if(size(#)>1)
+        {
+          seri=1;
+          peek=#[2];
+          ser=#[3];
+        }
+      }
+      else
+      {
+        seri=1;
+        peek=#[1];
+        ser=#[2];
+      }
+  }
+  if(abspri)
+  {
+     list absprimary,abskeep,absprimarytmp,abskeeptmp;
+  }
+  homo=homog(i);
+  if(homo==1)
+  {
+    if(attrib(i,"isSB")!=1)
+    {
+      //ltras=mstd(i);
+      tras=groebner(i);
+      ltras=tras,tras;
+      attrib(ltras[1],"isSB",1);
+    }
+    else
+    {
+      ltras=i,i;
+      attrib(ltras[1],"isSB",1);
+    }
+    tras=ltras[1];
+    attrib(tras,"isSB",1);
+    if(dim(tras)==0)
+    {
+        primary[1]=ltras[2];
+        primary[2]=maxideal(1);
+        if(@wr>0)
+        {
+           list l;
+           l[1]=maxideal(1);
+           l[2]=maxideal(1);
+           return(l);
+        }
+        return(primary);
+     }
+     for(@n=1;@n<=nvars(basering);@n++)
+     {
+        @w[@n]=ord(var(@n));
+     }
+     intvec @hilb=hilb(tras,1,@w);
+     intvec keephilb=@hilb;
+  }
+
+  //----------------------------------------------------------------
+  //i is the zero-ideal
+  //----------------------------------------------------------------
+
+  if(size(i)==0)
+  {
+     primary=i,i;
+     return(primary);
+  }
+
+  //----------------------------------------------------------------
+  //pass to the lexicographical ordering and compute a standardbasis
+  //----------------------------------------------------------------
+
+  int lp=islp();
+
+  execute("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),(C,lp);");
+  op=option(get);
+  option(redSB);
+
+  ideal ser=fetch(@P,ser);
+
+  if(homo==1)
+  {
+     if(!lp)
+     {
+       ideal @j=std(fetch(@P,i),@hilb,@w);
+     }
+     else
+     {
+        ideal @j=fetch(@P,tras);
+        attrib(@j,"isSB",1);
+     }
+  }
+  else
+  {
+      if(lp&&isS)
+      {
+        ideal @j=fetch(@P,i);
+        attrib(@j,"isSB",1);
+      }
+      else
+      {
+        ideal @j=groebner(fetch(@P,i));
+      }
+  }
+  option(set,op);
+  if(seri==1)
+  {
+    ideal peek=fetch(@P,peek);
+    attrib(peek,"isSB",1);
+  }
+  else
+  {
+    ideal peek=@j;
+  }
+  if((size(ser)==0)&&(!abspri))
+  {
+    ideal fried;
+    @n=size(@j);
+    for(@k=1;@k<=@n;@k++)
+    {
+      if(deg(lead(@j[@k]))==1)
+      {
+        fried[size(fried)+1]=@j[@k];
+        @j[@k]=0;
+      }
+    }
+    if(size(fried)==nvars(basering))
+    {
+       setring @P;
+       primary[1]=i;
+       primary[2]=i;
+       return(primary);
+    }
+    if(size(fried)>0)
+    {
+       string newva;
+       string newma;
+       for(@k=1;@k<=nvars(basering);@k++)
+       {
+          @n1=0;
+          for(@n=1;@n<=size(fried);@n++)
+          {
+             if(leadmonom(fried[@n])==var(@k))
+             {
+                @n1=1;
+                break;
+             }
+          }
+          if(@n1==0)
+          {
+            newva=newva+string(var(@k))+",";
+            newma=newma+string(var(@k))+",";
+          }
+          else
+          {
+            newma=newma+string(0)+",";
+          }
+       }
+       newva[size(newva)]=")";
+       newma[size(newma)]=";";
+       execute("ring @deirf=("+charstr(gnir)+"),("+newva+",lp;");
+       execute("map @kappa=gnir,"+newma);
+       ideal @j= @kappa(@j);
+       @j=simplify(@j,2);
+       attrib(@j,"isSB",1);
+       list pr=decomp(@j);
+       setring gnir;
+       list pr=imap(@deirf,pr);
+       for(@k=1;@k<=size(pr);@k++)
+       {
+         @j=pr[@k]+fried;
+         pr[@k]=@j;
+       }
+       setring @P;
+       return(imap(gnir,pr));
+    }
+  }
+  //----------------------------------------------------------------
+  //j is the ring
+  //----------------------------------------------------------------
+
+  if (dim(@j)==-1)
+  {
+    setring @P;
+    primary=ideal(1),ideal(1);
+    return(primary);
+  }
+
+  //----------------------------------------------------------------
+  //  the case of one variable
+  //----------------------------------------------------------------
+
+  if(nvars(basering)==1)
+  {
+
+     list fac=factor(@j[1]);
+     list gprimary;
+     for(@k=1;@k<=size(fac[1]);@k++)
+     {
+        if(@wr==0)
+        {
+           gprimary[2*@k-1]=ideal(fac[1][@k]^fac[2][@k]);
+           gprimary[2*@k]=ideal(fac[1][@k]);
+        }
+        else
+        {
+           gprimary[2*@k-1]=ideal(fac[1][@k]);
+           gprimary[2*@k]=ideal(fac[1][@k]);
+        }
+     }
+     setring @P;
+     primary=fetch(gnir,gprimary);
+
+//HIER
+    if(abspri)
+    {
+       list resu,tempo;
+       string absotto;
+       for(ab=1;ab<=size(primary)/2;ab++)
+       {
+          absotto= absFactorize(primary[2*ab][1],77);
+          tempo=primary[2*ab-1],primary[2*ab],absotto,string(var(nvars(basering)));
+          resu[ab]=tempo;
+       }
+       primary=resu;
+     }
+     return(primary);
+  }
+
+ //------------------------------------------------------------------
+ //the zero-dimensional case
+ //------------------------------------------------------------------
+  if (dim(@j)==0)
+  {
+    op=option(get);
+    option(redSB);
+    list gprimary= zero_decomp(@j,ser,@wr);
+
+    setring @P;
+    primary=fetch(gnir,gprimary);
+
+    if(size(ser)>0)
+    {
+      primary=cleanPrimary(primary);
+    }
+//HIER
+    if(abspri)
+    {
+       list resu,tempo;
+       string absotto;
+       for(ab=1;ab<=size(primary)/2;ab++)
+       {
+          absotto= absFactorize(primary[2*ab][1],77);
+          tempo=primary[2*ab-1],primary[2*ab],absotto,string(var(nvars(basering)));
+          resu[ab]=tempo;
+       }
+       primary=resu;
+    }
+    return(primary);
+  }
+
+  poly @gs,@gh,@p;
+  string @va,quotring;
+  list quprimary,htprimary,collectprimary,lsau,lnew,allindep,restindep;
+  ideal @h;
+  int jdim=dim(@j);
+  list fett;
+  int lauf,di,newtest;
+  //------------------------------------------------------------------
+  //search for a maximal independent set indep,i.e.
+  //look for subring such that the intersection with the ideal is zero
+  //j intersected with K[var(indep[3]+1),...,var(nvar] is zero,
+  //indep[1] is the new varstring and indep[2] the string for block-ordering
+  //------------------------------------------------------------------
+  if(@wr!=1)
+  {
+     allindep=independSet(@j);
+     for(@m=1;@m<=size(allindep);@m++)
+     {
+        if(allindep[@m][3]==jdim)
+        {
+           di++;
+           indep[di]=allindep[@m];
+        }
+        else
+        {
+           lauf++;
+           restindep[lauf]=allindep[@m];
+        }
+     }
+   }
+   else
+   {
+      indep=maxIndependSet(@j);
+   }
+
+  ideal jkeep=@j;
+  if(ordstr(@P)[1]=="w")
+  {
+     execute("ring @Phelp=("+charstr(gnir)+"),("+varstr(gnir)+"),("+ordstr(@P)+");");
+  }
+  else
+  {
+     execute( "ring @Phelp=("+charstr(gnir)+"),("+varstr(gnir)+"),(C,dp);");
+  }
+
+  if(homo==1)
+  {
+    if((ordstr(@P)[3]=="d")||(ordstr(@P)[1]=="d")||(ordstr(@P)[1]=="w")
+       ||(ordstr(@P)[3]=="w"))
+    {
+      ideal jwork=imap(@P,tras);
+      attrib(jwork,"isSB",1);
+    }
+    else
+    {
+      ideal jwork=std(imap(gnir,@j),@hilb,@w);
+    }
+
+  }
+  else
+  {
+    ideal jwork=groebner(imap(gnir,@j));
+  }
+  list hquprimary;
+  poly @p,@q;
+  ideal @h,fac,ser;
+  ideal @Ptest=1;
+  di=dim(jwork);
+  keepdi=di;
+
+  setring gnir;
+  for(@m=1;@m<=size(indep);@m++)
+  {
+     isat=0;
+     @n2=0;
+     if((indep[@m][1]==varstr(basering))&&(@m==1))
+     //this is the good case, nothing to do, just to have the same notations
+     //change the ring
+     {
+        execute("ring gnir1 = ("+charstr(basering)+"),("+varstr(basering)+"),("
+                              +ordstr(basering)+");");
+        ideal @j=fetch(gnir,@j);
+        attrib(@j,"isSB",1);
+        ideal ser=fetch(gnir,ser);
+
+     }
+     else
+     {
+        @va=string(maxideal(1));
+        if(@m==1)
+        {
+           @j=fetch(@P,i);
+        }
+        execute("ring gnir1 = ("+charstr(basering)+"),("+indep[@m][1]+"),("
+                              +indep[@m][2]+");");
+        execute("map phi=gnir,"+@va+";");
+        op=option(get);
+        option(redSB);
+        if(homo==1)
+        {
+           ideal @j=std(phi(@j),@hilb,@w);
+        }
+        else
+        {
+          ideal @j=groebner(phi(@j));
+        }
+        ideal ser=phi(ser);
+
+        option(set,op);
+     }
+     if((deg(@j[1])==0)||(dim(@j)<jdim))
+     {
+       setring gnir;
+       break;
+     }
+     for (lauf=1;lauf<=size(@j);lauf++)
+     {
+         fett[lauf]=size(@j[lauf]);
+     }
+     //------------------------------------------------------------------------
+     //we have now the following situation:
+     //j intersected with K[var(nnp+1),..,var(nva)] is zero so we may pass
+     //to this quotientring, j is their still a standardbasis, the
+     //leading coefficients of the polynomials  there (polynomials in
+     //K[var(nnp+1),..,var(nva)]) are collected in the list h,
+     //we need their ggt, gh, because of the following: let
+     //(j:gh^n)=(j:gh^infinity) then j*K(var(nnp+1),..,var(nva))[..the rest..]
+     //intersected with K[var(1),...,var(nva)] is (j:gh^n)
+     //on the other hand j=(j,gh^n) intersected with (j:gh^n)
+
+     //------------------------------------------------------------------------
+
+     //arrangement for quotientring K(var(nnp+1),..,var(nva))[..the rest..] and
+     //map phi:K[var(1),...,var(nva)] --->K(var(nnpr+1),..,var(nva))[..rest..]
+     //------------------------------------------------------------------------
+
+     quotring=prepareQuotientring(nvars(basering)-indep[@m][3]);
+
+     //---------------------------------------------------------------------
+     //we pass to the quotientring   K(var(nnp+1),..,var(nva))[..the rest..]
+     //---------------------------------------------------------------------
+
+     ideal @jj=lead(@j);               //!! vorn vereinbaren
+     execute(quotring);
+
+     ideal @jj=imap(gnir1,@jj);
+     @vv=clearSBNeu(@jj,fett);  //!! vorn vereinbaren
+     setring gnir1;
+     @k=size(@j);
+     for (lauf=1;lauf<=@k;lauf++)
+     {
+         if(@vv[lauf]==1)
+         {
+            @j[lauf]=0;
+         }
+     }
+     @j=simplify(@j,2);
+     setring quring;
+      // @j considered in the quotientring
+     ideal @j=imap(gnir1,@j);
+
+     ideal ser=imap(gnir1,ser);
+
+     kill gnir1;
+
+     //j is a standardbasis in the quotientring but usually not minimal
+     //here it becomes minimal
+
+     attrib(@j,"isSB",1);
+
+     //we need later ggt(h[1],...)=gh for saturation
+     ideal @h;
+     if(deg(@j[1])>0)
+     {
+        for(@n=1;@n<=size(@j);@n++)
+        {
+           @h[@n]=leadcoef(@j[@n]);
+        }
+        //the primary decomposition of j*K(var(nnp+1),..,var(nva))[..the rest..]
+        op=option(get);
+        option(redSB);
+
+        list uprimary= zero_decomp(@j,ser,@wr);
+//HIER
+        if(abspri)
+        {
+           ideal II;
+           ideal jmap;
+           map sigma;
+           nn=nvars(basering);
+           map invsigma=basering,maxideal(1);
+           for(ab=1;ab<=size(uprimary)/2;ab++)
+           {
+              II=uprimary[2*ab];
+              attrib(II,"isSB",1);
+              if(deg(II[1])!=vdim(II))
+              {
+                 jmap=randomLast(50);
+                 sigma=basering,jmap;
+                 jmap[nn]=2*var(nn)-jmap[nn];
+                 invsigma=basering,jmap;
+                 II=groebner(sigma(II));
+               }
+               absprimarytmp[ab]= absFactorize(II[1],77);
+               II=var(nn);
+               abskeeptmp[ab]=string(invsigma(II));
+               invsigma=basering,maxideal(1);
+           }
+        }
+        option(set,op);
+     }
+     else
+     {
+       list uprimary;
+       uprimary[1]=ideal(1);
+       uprimary[2]=ideal(1);
+     }
+     //we need the intersection of the ideals in the list quprimary with the
+     //polynomialring, i.e. let q=(f1,...,fr) in the quotientring such an ideal
+     //but fi polynomials, then the intersection of q with the polynomialring
+     //is the saturation of the ideal generated by f1,...,fr with respect to
+     //h which is the lcm of the leading coefficients of the fi considered in
+     //in the quotientring: this is coded in saturn
+
+     list saturn;
+     ideal hpl;
+
+     for(@n=1;@n<=size(uprimary);@n++)
+     {
+        uprimary[@n]=interred(uprimary[@n]); // temporary fix
+        hpl=0;
+        for(@n1=1;@n1<=size(uprimary[@n]);@n1++)
+        {
+           hpl=hpl,leadcoef(uprimary[@n][@n1]);
+        }
+        saturn[@n]=hpl;
+     }
+
+     //--------------------------------------------------------------------
+     //we leave  the quotientring   K(var(nnp+1),..,var(nva))[..the rest..]
+     //back to the polynomialring
+     //---------------------------------------------------------------------
+     setring gnir;
+
+     collectprimary=imap(quring,uprimary);
+     lsau=imap(quring,saturn);
+     @h=imap(quring,@h);
+
+     kill quring;
+
+     @n2=size(quprimary);
+     @n3=@n2;
+
+     for(@n1=1;@n1<=size(collectprimary)/2;@n1++)
+     {
+        if(deg(collectprimary[2*@n1][1])>0)
+        {
+           @n2++;
+           quprimary[@n2]=collectprimary[2*@n1-1];
+           lnew[@n2]=lsau[2*@n1-1];
+           @n2++;
+           lnew[@n2]=lsau[2*@n1];
+           quprimary[@n2]=collectprimary[2*@n1];
+           if(abspri)
+           {
+              absprimary[@n2/2]=absprimarytmp[@n1];
+              abskeep[@n2/2]=abskeeptmp[@n1];
+           }
+        }
+     }
+     //here the intersection with the polynomialring
+     //mentioned above is really computed
+     for(@n=@n3/2+1;@n<=@n2/2;@n++)
+     {
+        if(specialIdealsEqual(quprimary[2*@n-1],quprimary[2*@n]))
+        {
+           quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
+           quprimary[2*@n]=quprimary[2*@n-1];
+        }
+        else
+        {
+           if(@wr==0)
+           {
+              quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
+           }
+           quprimary[2*@n]=sat2(quprimary[2*@n],lnew[2*@n])[1];
+        }
+     }
+
+     if(size(@h)>0)
+     {
+           //---------------------------------------------------------------
+           //we change to @Phelp to have the ordering dp for saturation
+           //---------------------------------------------------------------
+        setring @Phelp;
+        @h=imap(gnir,@h);
+        if(@wr!=1)
+        {
+          if(defined(@LL)){kill @LL;}
+          list @LL=minSat(jwork,@h);
+          @Ptest=intersect(@Ptest,@LL[1]);
+          @q=@LL[2];
+        }
+        else
+        {
+            fac=ideal(0);
+            for(lauf=1;lauf<=ncols(@h);lauf++)
+           {
+              if(deg(@h[lauf])>0)
+              {
+                 fac=fac+factorize(@h[lauf],1);
+              }
+           }
+           fac=simplify(fac,6);
+           @q=1;
+           for(lauf=1;lauf<=size(fac);lauf++)
+           {
+             @q=@q*fac[lauf];
+           }
+        }
+        jwork=std(jwork,@q);
+        keepdi=dim(jwork);
+        if(keepdi<di)
+        {
+           setring gnir;
+           @j=imap(@Phelp,jwork);
+           break;
+        }
+        if(homo==1)
+        {
+              @hilb=hilb(jwork,1,@w);
+        }
+
+        setring gnir;
+        @j=imap(@Phelp,jwork);
+     }
+  }
+
+  if((size(quprimary)==0)&&(@wr==1))
+  {
+     @j=ideal(1);
+     quprimary[1]=ideal(1);
+     quprimary[2]=ideal(1);
+  }
+  if((size(quprimary)==0))
+  {
+    keepdi=di-1;
+    quprimary[1]=ideal(1);
+    quprimary[2]=ideal(1);
+  }
+  //---------------------------------------------------------------
+  //notice that j=sat(j,gh) intersected with (j,gh^n)
+  //we finished with sat(j,gh) and have to start with (j,gh^n)
+  //---------------------------------------------------------------
+  if((deg(@j[1])!=0)&&(@wr!=1))
+  {
+     if(size(quprimary)>0)
+     {
+        setring @Phelp;
+        ser=imap(gnir,ser);
+        hquprimary=imap(gnir,quprimary);
+        if(@wr==0)
+        {
+           //HIER STATT DURCHSCHNITT SATURIEREN!
+           ideal htest=@Ptest;
+        }
+        else
+        {
+           ideal htest=hquprimary[2];
+
+           for (@n1=2;@n1<=size(hquprimary)/2;@n1++)
+           {
+              htest=intersect(htest,hquprimary[2*@n1]);
+           }
+        }
+
+        if(size(ser)>0)
+        {
+           ser=intersect(htest,ser);
+        }
+        else
+        {
+          ser=htest;
+        }
+        setring gnir;
+        ser=imap(@Phelp,ser);
+     }
+     if(size(reduce(ser,peek,1))!=0)
+     {
+        for(@m=1;@m<=size(restindep);@m++)
+        {
+         // if(restindep[@m][3]>=keepdi)
+         // {
+           isat=0;
+           @n2=0;
+
+           if(restindep[@m][1]==varstr(basering))
+           //the good case, nothing to do, just to have the same notations
+           //change the ring
+           {
+              execute("ring gnir1 = ("+charstr(basering)+"),("+
+                varstr(basering)+"),("+ordstr(basering)+");");
+              ideal @j=fetch(gnir,jkeep);
+              attrib(@j,"isSB",1);
+           }
+           else
+           {
+              @va=string(maxideal(1));
+              execute("ring gnir1 = ("+charstr(basering)+"),("+
+                      restindep[@m][1]+"),(" +restindep[@m][2]+");");
+              execute("map phi=gnir,"+@va+";");
+              op=option(get);
+              option(redSB);
+              if(homo==1)
+              {
+                 ideal @j=std(phi(jkeep),keephilb,@w);
+              }
+              else
+              {
+                ideal @j=groebner(phi(jkeep));
+              }
+              ideal ser=phi(ser);
+              option(set,op);
+           }
+
+           for (lauf=1;lauf<=size(@j);lauf++)
+           {
+              fett[lauf]=size(@j[lauf]);
+           }
+           //------------------------------------------------------------------
+           //we have now the following situation:
+           //j intersected with K[var(nnp+1),..,var(nva)] is zero so we may
+           //pass to this quotientring, j is their still a standardbasis, the
+           //leading coefficients of the polynomials  there (polynomials in
+           //K[var(nnp+1),..,var(nva)]) are collected in the list h,
+           //we need their ggt, gh, because of the following:
+           //let (j:gh^n)=(j:gh^infinity) then
+           //j*K(var(nnp+1),..,var(nva))[..the rest..]
+           //intersected with K[var(1),...,var(nva)] is (j:gh^n)
+           //on the other hand j=(j,gh^n) intersected with (j:gh^n)
+
+           //------------------------------------------------------------------
+
+           //the arrangement for the quotientring
+           // K(var(nnp+1),..,var(nva))[..the rest..]
+           //and the map phi:K[var(1),...,var(nva)] ---->
+           //--->K(var(nnpr+1),..,var(nva))[..the rest..]
+           //------------------------------------------------------------------
+
+           quotring=prepareQuotientring(nvars(basering)-restindep[@m][3]);
+
+           //------------------------------------------------------------------
+           //we pass to the quotientring  K(var(nnp+1),..,var(nva))[..rest..]
+           //------------------------------------------------------------------
+
+           execute(quotring);
+
+           // @j considered in the quotientring
+           ideal @j=imap(gnir1,@j);
+           ideal ser=imap(gnir1,ser);
+
+           kill gnir1;
+
+           //j is a standardbasis in the quotientring but usually not minimal
+           //here it becomes minimal
+           @j=clearSB(@j,fett);
+           attrib(@j,"isSB",1);
+
+           //we need later ggt(h[1],...)=gh for saturation
+           ideal @h;
+
+           for(@n=1;@n<=size(@j);@n++)
+           {
+              @h[@n]=leadcoef(@j[@n]);
+           }
+           //the primary decomposition of j*K(var(nnp+1),..,var(nva))[..rest..]
+
+           op=option(get);
+           option(redSB);
+           list uprimary= zero_decomp(@j,ser,@wr);
+//HIER
+           if(abspri)
+           {
+              ideal II;
+              ideal jmap;
+              map sigma;
+              nn=nvars(basering);
+              map invsigma=basering,maxideal(1);
+              for(ab=1;ab<=size(uprimary)/2;ab++)
+              {
+                 II=uprimary[2*ab];
+                 attrib(II,"isSB",1);
+                 if(deg(II[1])!=vdim(II))
+                 {
+                    jmap=randomLast(50);
+                    sigma=basering,jmap;
+                    jmap[nn]=2*var(nn)-jmap[nn];
+                    invsigma=basering,jmap;
+                    II=groebner(sigma(II));
+                  }
+                  absprimarytmp[ab]= absFactorize(II[1],77);
+                  II=var(nn);
+                  abskeeptmp[ab]=string(invsigma(II));
+                  invsigma=basering,maxideal(1);
+              }
+           }
+           option(set,op);
+
+           //we need the intersection of the ideals in the list quprimary with
+           //the polynomialring, i.e. let q=(f1,...,fr) in the quotientring
+           //such an ideal but fi polynomials, then the intersection of q with
+           //the polynomialring is the saturation of the ideal generated by
+           //f1,...,fr with respect toh which is the lcm of the leading
+           //coefficients of the fi considered in the quotientring:
+           //this is coded in saturn
+
+           list saturn;
+           ideal hpl;
+
+           for(@n=1;@n<=size(uprimary);@n++)
+           {
+              hpl=0;
+              for(@n1=1;@n1<=size(uprimary[@n]);@n1++)
+              {
+                 hpl=hpl,leadcoef(uprimary[@n][@n1]);
+              }
+               saturn[@n]=hpl;
+           }
+           //------------------------------------------------------------------
+           //we leave  the quotientring   K(var(nnp+1),..,var(nva))[..rest..]
+           //back to the polynomialring
+           //------------------------------------------------------------------
+           setring gnir;
+           collectprimary=imap(quring,uprimary);
+           lsau=imap(quring,saturn);
+           @h=imap(quring,@h);
+
+           kill quring;
+
+
+           @n2=size(quprimary);
+           @n3=@n2;
+
+           for(@n1=1;@n1<=size(collectprimary)/2;@n1++)
+           {
+              if(deg(collectprimary[2*@n1][1])>0)
+              {
+                 @n2++;
+                 quprimary[@n2]=collectprimary[2*@n1-1];
+                 lnew[@n2]=lsau[2*@n1-1];
+                 @n2++;
+                 lnew[@n2]=lsau[2*@n1];
+                 quprimary[@n2]=collectprimary[2*@n1];
+                 if(abspri)
+                 {
+                   absprimary[@n2/2]=absprimarytmp[@n1];
+                   abskeep[@n2/2]=abskeeptmp[@n1];
+                 }
+              }
+           }
+
+
+           //here the intersection with the polynomialring
+           //mentioned above is really computed
+
+           for(@n=@n3/2+1;@n<=@n2/2;@n++)
+           {
+              if(specialIdealsEqual(quprimary[2*@n-1],quprimary[2*@n]))
+              {
+                 quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
+                 quprimary[2*@n]=quprimary[2*@n-1];
+              }
+              else
+              {
+                 if(@wr==0)
+                 {
+                    quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
+                 }
+                 quprimary[2*@n]=sat2(quprimary[2*@n],lnew[2*@n])[1];
+              }
+           }
+           if(@n2>=@n3+2)
+           {
+              setring @Phelp;
+              ser=imap(gnir,ser);
+              hquprimary=imap(gnir,quprimary);
+              for(@n=@n3/2+1;@n<=@n2/2;@n++)
+              {
+                if(@wr==0)
+                {
+                   ser=intersect(ser,hquprimary[2*@n-1]);
+                }
+                else
+                {
+                   ser=intersect(ser,hquprimary[2*@n]);
+                }
+              }
+              setring gnir;
+              ser=imap(@Phelp,ser);
+           }
+
+         // }
+        }
+//HIER
+        if(abspri)
+        {
+          list resu,tempo;
+          for(ab=1;ab<=size(quprimary)/2;ab++)
+          {
+             if (deg(quprimary[2*ab][1])!=0)
+             {
+               tempo=quprimary[2*ab-1],quprimary[2*ab],
+                         absprimary[ab],abskeep[ab];
+               resu[ab]=tempo;
+             }
+          }
+          quprimary=resu;
+          @wr=3;
+        }
+        if(size(reduce(ser,peek,1))!=0)
+        {
+           if(@wr>0)
+           {
+              htprimary=decomp(@j,@wr,peek,ser);
+           }
+           else
+           {
+              htprimary=decomp(@j,peek,ser);
+           }
+           // here we collect now both results primary(sat(j,gh))
+           // and primary(j,gh^n)
+           @n=size(quprimary);
+           for (@k=1;@k<=size(htprimary);@k++)
+           {
+              quprimary[@n+@k]=htprimary[@k];
+           }
+        }
+     }
+
+   }
+   else
+   {
+      if(abspri)
+      {
+        list resu,tempo;
+        for(ab=1;ab<=size(quprimary)/2;ab++)
+        {
+           tempo=quprimary[2*ab-1],quprimary[2*ab],
+                   absprimary[ab],abskeep[ab];
+           resu[ab]=tempo;
+        }
+        quprimary=resu;
+      }
+   }
+  //---------------------------------------------------------------------------
+  //back to the ring we started with
+  //the final result: primary
+  //---------------------------------------------------------------------------
+
+  setring @P;
+  primary=imap(gnir,quprimary);
+  if(!abspri)
+  {
+     primary=cleanPrimary(primary);
+  }
+  return(primary);
+}
+
+
+example
+{ "EXAMPLE:"; echo = 2;
+   ring  r = 32003,(x,y,z),lp;
+   poly  p = z2+1;
+   poly  q = z4+2;
+   ideal i = p^2*q^3,(y-z3)^3,(x-yz+z4)^4;
+   list pr= decomp(i);
+   pr;
+   testPrimary( pr, i);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+static proc powerCoeffs(poly f,int e)
+//computes a polynomial with the same monomials as f but coefficients
+//the p^e th power of the coefficients of f
+{
+   int i;
+   poly g;
+   int ex=char(basering)^e;
+   for(i=1;i<=size(f);i++)
+   {
+      g=g+leadcoef(f[i])^ex*leadmonom(f[i]);
+   }
+   return(g);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc sep(poly f,int i, list #)
+"USAGE:  input: a polynomial f depending on the i-th variable and optional
+         an integer k considering the polynomial f defined over Fp(t1,...,tm)
+         as polynomial over Fp(t(1)^(p^-k),...,t(m)^(p^-k))
+ RETURN: the separabel part of f as polynomial in Fp(t1,...,tm)
+        and an integer k to indicate that f should be considerd
+        as polynomial over Fp(t(1)^(p^-k),...,t(m)^(p^-k))
+ EXAMPLE: example sep; shows an example
+{
+   def R=basering;
+   int k;
+   if(size(#)>0){k=#[1];}
+
+
+   poly h=gcd(f,diff(f,var(i)));
+   if((reduce(f,std(h))!=0)||(reduce(diff(f,var(i)),std(h))!=0))
+   {
+      ERROR("FEHLER IN GCD");
+   }
+   poly g1=lift(h,f)[1][1];    //  f/h
+   poly h1;
+
+   while(h!=h1)
+   {
+      h1=h;
+      h=gcd(h,diff(h,var(i)));
+   }
+
+   if(deg(h1)==0){return(list(g1,k));} //in characteristic 0 we return here
+
+   k++;
+
+   ideal ma=maxideal(1);
+   ma[i]=var(i)^char(R);
+   map phi=R,ma;
+   ideal hh=h;    //this is technical because preimage works only for ideals
+
+   poly u=preimage(R,phi,hh)[1]; //h=u(x(i)^p)
+
+   list g2=sep(u,i,k);           //we consider u(t(1)^(p^-1),...,t(m)^(p^-1))
+   g1=powerCoeffs(g1,g2[2]-k+1); //to have g1 over the same field as g2[1]
+
+   list g3=sep(g1*g2[1],i,g2[2]);
+   return(g3);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring R=(5,t,s),(x,y,z),dp;
+   poly f=(x^25-t*x^5+t)*(x^3+s);
+   sep(f,1);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+ proc zeroRad(ideal I,list #)
+"USAGE:  zeroRad(I) , I a zero-dimensional ideal
+ RETURN: the radical of I
+ NOTE:  Algorithm of Kemper
+ EXAMPLE: example zeroRad; shows an example
+{
+   if(homog(I)==1){return(maxideal(1));}
+   //I needs to be a reduced standard basis
+   def R=basering;
+   int m=npars(R);
+   int n=nvars(R);
+   int p=char(R);
+   int d=vdim(I);
+   int i,k;
+   list l;
+   if(((p==0)||(p>d))&&(d==deg(I[1])))
+   {
+     intvec e=leadexp(I[1]);
+     for(i=1;i<=nvars(basering);i++)
+     {
+       if(e[i]!=0) break;
+     }
+     I[1]=sep(I[1],i)[1];
+     return(interred(I));
+   }
+   intvec op=option(get);
+
+   option(redSB);
+   ideal F=finduni(I);//F[i] generates I intersected with K[var(i)]
+
+   option(set,op);
+   if(size(#)>0){I=#[1];}
+
+   for(i=1;i<=n;i++)
+   {
+      l[i]=sep(F[i],i);
+      F[i]=l[i][1];
+      if(l[i][2]>k){k=l[i][2];}  //computation of the maximal k
+   }
+
+   if((k==0)||(m==0)){return(interred(I+F));}        //the separable case
+
+   for(i=1;i<=n;i++)             //consider all polynomials over
+   {                             //Fp(t(1)^(p^-k),...,t(m)^(p^-k))
+      F[i]=powerCoeffs(F[i],k-l[i][2]);
+   }
+
+   string cR="ring @R="+string(p)+",("+parstr(R)+","+varstr(R)+"),dp;";
+   execute(cR);
+   ideal F=imap(R,F);
+
+   string nR="ring @S="+string(p)+",(y(1..m),"+varstr(R)+","+parstr(R)+"),dp;";
+   execute(nR);
+
+   ideal G=fetch(@R,F);    //G[i](t(1)^(p^-k),...,t(m)^(p^-k),x(i))=sep(F[i])
+
+   ideal I=imap(R,I);
+   ideal J=I+G;
+   poly el=1;
+   k=p^k;
+   for(i=1;i<=m;i++)
+   {
+      J=J,var(i)^k-var(m+n+i);
+      el=el*y(i);
+   }
+
+   J=eliminate(J,el);
+   setring R;
+   ideal J=imap(@S,J);
+   return(J);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring R=(5,t),(x,y),dp;
+   ideal I=x^5-t,y^5-t;
+   zeroRad(I);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc radicalEHV(ideal i)
+"USAGE:   radicalEHV(i); i ideal.
+RETURN:  ideal, the radical of i.
+NOTE:    Uses the algorithm of Eisenbud/Huneke/Vasconcelos, which
+         reduces the computation to the complete intersection case,
+         by taking, in the general case, a generic linear combination
+         of the input.
+         Works only in characteristic 0 or p large.
+EXAMPLE: example radicalEHV; shows an example
+"
+{
+   if(attrib(basering,"global")!=1)
+   {
+      ERROR(
+      "// Not implemented for this ordering, please change to global ordering."
+      );
+   }
+   if((char(basering)<100)&&(char(basering)!=0))
+   {
+      "WARNING: The characteristic is too small, the result may be wrong";
+   }
+   ideal J,I,I0,radI0,L,radI1,I2,radI2;
+   int l,n;
+   intvec op=option(get);
+   matrix M;
+
+   option(redSB);
+   list m=mstd(i);
+        I=m[2];
+   option(set,op);
+
+   int cod=nvars(basering)-dim(m[1]);
+   //-------------------complete intersection case:----------------------
+   if(cod==size(m[2]))
+   {
+     J=minor(jacob(I),cod);
+     return(quotient(I,J));
+   }
+   //-----first codim elements of I are a complete intersection:---------
+   for(l=1;l<=cod;l++)
+   {
+      I0[l]=I[l];
+   }
+   n=dim(std(I0))+cod-nvars(basering);
+   //-----last codim elements of I are a complete intersection:----------
+   if(n!=0)
+   {
+      for(l=1;l<=cod;l++)
+      {
+         I0[l]=I[size(I)-l+1];
+      }
+      n=dim(std(I0))+cod-nvars(basering);
+   }
+   //-----taking a generic linear combination of the input:--------------
+   if(n!=0)
+   {
+      M=transpose(sparsetriag(size(m[2]),cod,95,1));
+      I0=ideal(M*transpose(I));
+      n=dim(std(I0))+cod-nvars(basering);
+   }
+   //-----taking a more generic linear combination of the input:---------
+   if(n!=0)
+   {
+      M=transpose(sparsetriag(size(m[2]),cod,0,100));
+      I0=ideal(M*transpose(I));
+      n=dim(std(I0))+cod-nvars(basering);
+   }
+   if(n==0)
+   {
+      J=minor(jacob(I0),cod);
+      radI0=quotient(I0,J);
+      L=quotient(radI0,I);
+      radI1=quotient(radI0,L);
+
+      if(size(reduce(radI1,m[1],1))==0)
+      {
+         return(I);
+      }
+
+      I2=sat(I,radI1)[1];
+
+      if(deg(I2[1])<=0)
+      {
+         return(radI1);
+      }
+      return(intersect(radI1,radicalEHV(I2)));
+   }
+   //---------------------general case-------------------------------------
+   return(radical(I));
+}
+example
+{ "EXAMPLE:";  echo = 2;
+   ring  r = 0,(x,y,z),dp;
+   poly  p = z2+1;
+   poly  q = z3+2;
+   ideal i = p*q^2,y-z2;
+   ideal pr= radicalEHV(i);
+   pr;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc Ann(module M)
+"USAGE:   Ann(M);  M module
+RETURN:  ideal, the annihilator of coker(M)
+NOTE:    The output is the ideal of all elements a of the basering R such that
+         a * R^m is contained in M  (m=number of rows of M).
+EXAMPLE: example Ann; shows an example
+"
+{
+  M=prune(M);  //to obtain a small embedding
+  ideal ann=quotient1(M,freemodule(nrows(M)));
+  return(ann);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring  r = 0,(x,y,z),lp;
+   module M = x2-y2,z3;
+   Ann(M);
+   M = [1,x2],[y,x];
+   Ann(M);
+   qring Q=std(xy-1);
+   module M=imap(r,M);
+   Ann(M);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+//computes the equidimensional part of the ideal i of codimension e
+static proc int_ass_primary_e(ideal i, int e)
+{
+  if(homog(i)!=1)
+  {
+     i=std(i);
+  }
+  list re=sres(i,0);                   //the resolution
+  re=minres(re);                       //minimized resolution
+  ideal ann=AnnExt_R(e,re);
+  if(nvars(basering)-dim(std(ann))!=e)
+  {
+    return(ideal(1));
+  }
+  return(ann);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+//computes the annihilator of Ext^n(R/i,R) with given resolution re
+//n is not necessarily the number of variables
+static proc AnnExt_R(int n,list re)
+{
+  if(n<nvars(basering))
+  {
+     matrix f=transpose(re[n+1]);      //Hom(_,R)
+     module k=nres(f,2)[2];            //the kernel
+     matrix g=transpose(re[n]);        //the image of Hom(_,R)
+
+     ideal ann=quotient1(g,k);           //the anihilator
+  }
+  else
+  {
+     ideal ann=Ann(transpose(re[n]));
+  }
+  return(ann);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+static proc analyze(list pr)
+{
+   int ii,jj;
+   for(ii=1;ii<=size(pr)/2;ii++)
+   {
+      dim(std(pr[2*ii]));
+      idealsEqual(pr[2*ii-1],pr[2*ii]);
+      "===========================";
+   }
+
+   for(ii=size(pr)/2;ii>1;ii--)
+   {
+      for(jj=1;jj<ii;jj++)
+      {
+         if(size(reduce(pr[2*jj],std(pr[2*ii],1)))==0)
+         {
+            "eingebette Komponente";
+            jj;
+            ii;
+         }
+      }
+   }
+}
+
+///////////////////////////////////////////////////////////////////////////////
+//
+//                  Shimoyama-Yokoyama
+//
+///////////////////////////////////////////////////////////////////////////////
+
+static proc simplifyIdeal(ideal i)
+{
+  def r=basering;
+
+  int j,k;
+  map phi;
+  poly p;
+
+  ideal iwork=i;
+  ideal imap1=maxideal(1);
+  ideal imap2=maxideal(1);
+
+
+  for(j=1;j<=nvars(basering);j++)
+  {
+    for(k=1;k<=size(i);k++)
+    {
+      if(deg(iwork[k]/var(j))==0)
+      {
+        p=-1/leadcoef(iwork[k]/var(j))*iwork[k];
+        imap1[j]=p+2*var(j);
+        phi=r,imap1;
+        iwork=phi(iwork);
+        iwork=subst(iwork,var(j),0);
+        iwork[k]=var(j);
+        imap1=maxideal(1);
+        imap2[j]=-p;
+        break;
+      }
+    }
+  }
+  return(iwork,imap2);
+}
+
+
+///////////////////////////////////////////////////////
+// ini_mod
+// input: a polynomial p
+// output: the initial term of p as needed
+// in the context of characteristic sets
+//////////////////////////////////////////////////////
+
+static proc ini_mod(poly p)
+{
+  if (p==0)
+  {
+    return(0);
+  }
+  int n; matrix m;
+  for( n=nvars(basering); n>0; n--)
+  {
+    m=coef(p,var(n));
+    if(m[1,1]!=1)
+    {
+      p=m[2,1];
+      break;
+    }
+  }
+  if(deg(p)==0)
+  {
+    p=0;
+  }
+  return(p);
+}
+///////////////////////////////////////////////////////
+// min_ass_prim_charsets
+// input: generators of an ideal PS and an integer cho
+// If cho=0, the given ordering of the variables is used.
+// Otherwise, the system tries to find an "optimal ordering",
+// which in some cases may considerably speed up the algorithm
+// output: the minimal associated primes of PS
+// algorithm: via characteriostic sets
+//////////////////////////////////////////////////////
+
+
+static proc min_ass_prim_charsets (ideal PS, int cho)
+{
+  if((cho<0) and (cho>1))
+  {
+    ERROR("<int> must be 0 or 1");
+  }
+  option(notWarnSB);
+  if(cho==0)
+  {
+    return(min_ass_prim_charsets0(PS));
+  }
+  else
+  {
+     return(min_ass_prim_charsets1(PS));
+  }
+}
+///////////////////////////////////////////////////////
+// min_ass_prim_charsets0
+// input: generators of an ideal PS
+// output: the minimal associated primes of PS
+// algorithm: via characteristic sets
+// the given ordering of the variables is used
+//////////////////////////////////////////////////////
+
+
+static proc min_ass_prim_charsets0 (ideal PS)
+{
+  intvec op;
+  matrix m=char_series(PS);  // We compute an irreducible
+                             // characteristic series
+  int i,j,k;
+  list PSI;
+  list PHI;  // the ideals given by the characteristic series
+  for(i=nrows(m);i>=1; i--)
+  {
+    PHI[i]=ideal(m[i,1..ncols(m)]);
+  }
+  // We compute the radical of each ideal in PHI
+  ideal I,JS,II;
+  int sizeJS, sizeII;
+  for(i=size(PHI);i>=1; i--)
+  {
+    I=0;
+    for(j=size(PHI[i]);j>0;j--)
+    {
+      I=I+ini_mod(PHI[i][j]);
+    }
+    JS=std(PHI[i]);
+    sizeJS=size(JS);
+    for(j=size(I);j>0;j--)
+    {
+      II=0;
+      sizeII=0;
+      k=0;
+      while(k<=sizeII)                  // successive saturation
+      {
+        op=option(get);
+        option(returnSB);
+        II=quotient(JS,I[j]);
+        option(set,op);
+        sizeII=size(II);
+        if(sizeII==sizeJS)
+        {
+          for(k=1;k<=sizeII;k++)
+          {
+            if(leadexp(II[k])!=leadexp(JS[k])) break;
+          }
+        }
+        JS=II;
+        sizeJS=sizeII;
+      }
+    }
+    PSI=insert(PSI,JS);
+  }
+  int sizePSI=size(PSI);
+  // We eliminate redundant ideals
+  for(i=1;i<sizePSI;i++)
+  {
+    for(j=i+1;j<=sizePSI;j++)
+    {
+      if(size(PSI[i])!=0)
+      {
+        if(size(PSI[j])!=0)
+        {
+          if(size(NF(PSI[i],PSI[j],1))==0)
+          {
+            PSI[j]=ideal(0);
+          }
+          else
+          {
+            if(size(NF(PSI[j],PSI[i],1))==0)
+            {
+              PSI[i]=ideal(0);
+            }
+          }
+        }
+      }
+    }
+  }
+  for(i=sizePSI;i>=1;i--)
+  {
+    if(size(PSI[i])==0)
+    {
+      PSI=delete(PSI,i);
+    }
+  }
+  return (PSI);
+}
+
+///////////////////////////////////////////////////////
+// min_ass_prim_charsets1
+// input: generators of an ideal PS
+// output: the minimal associated primes of PS
+// algorithm: via characteristic sets
+// input: generators of an ideal PS and an integer i
+// The system tries to find an "optimal ordering" of
+// the variables
+//////////////////////////////////////////////////////
+
+
+static proc min_ass_prim_charsets1 (ideal PS)
+{
+  intvec op;
+  def oldring=basering;
+  string n=system("neworder",PS);
+  execute("ring r=("+charstr(oldring)+"),("+n+"),dp;");
+  ideal PS=imap(oldring,PS);
+  matrix m=char_series(PS);  // We compute an irreducible
+                             // characteristic series
+  int i,j,k;
+  ideal I;
+  list PSI;
+  list PHI;    // the ideals given by the characteristic series
+  list ITPHI;  // their initial terms
+  for(i=nrows(m);i>=1; i--)
+  {
+    PHI[i]=ideal(m[i,1..ncols(m)]);
+    I=0;
+    for(j=size(PHI[i]);j>0;j=j-1)
+    {
+      I=I,ini_mod(PHI[i][j]);
+    }
+    I=I[2..ncols(I)];
+    ITPHI[i]=I;
+  }
+  setring oldring;
+  matrix m=imap(r,m);
+  list PHI=imap(r,PHI);
+  list ITPHI=imap(r,ITPHI);
+  // We compute the radical of each ideal in PHI
+  ideal I,JS,II;
+  int sizeJS, sizeII;
+  for(i=size(PHI);i>=1; i--)
+  {
+    I=0;
+    for(j=size(PHI[i]);j>0;j--)
+    {
+      I=I+ITPHI[i][j];
+    }
+    JS=std(PHI[i]);
+    sizeJS=size(JS);
+    for(j=size(I);j>0;j--)
+    {
+      II=0;
+      sizeII=0;
+      k=0;
+      while(k<=sizeII)                  // successive iteration
+      {
+        op=option(get);
+        option(returnSB);
+        II=quotient(JS,I[j]);
+        option(set,op);
+//std
+//         II=std(II);
+        sizeII=size(II);
+        if(sizeII==sizeJS)
+        {
+          for(k=1;k<=sizeII;k++)
+          {
+            if(leadexp(II[k])!=leadexp(JS[k])) break;
+          }
+        }
+        JS=II;
+        sizeJS=sizeII;
+      }
+    }
+    PSI=insert(PSI,JS);
+  }
+  int sizePSI=size(PSI);
+  // We eliminate redundant ideals
+  for(i=1;i<sizePSI;i++)
+  {
+    for(j=i+1;j<=sizePSI;j++)
+    {
+      if(size(PSI[i])!=0)
+      {
+        if(size(PSI[j])!=0)
+        {
+          if(size(NF(PSI[i],PSI[j],1))==0)
+          {
+            PSI[j]=ideal(0);
+          }
+          else
+          {
+            if(size(NF(PSI[j],PSI[i],1))==0)
+            {
+              PSI[i]=ideal(0);
+            }
+          }
+        }
+      }
+    }
+  }
+  for(i=sizePSI;i>=1;i--)
+  {
+    if(size(PSI[i])==0)
+    {
+      PSI=delete(PSI,i);
+    }
+  }
+  return (PSI);
+}
+
+
+/////////////////////////////////////////////////////
+// proc prim_dec
+// input:  generators of an ideal I and an integer choose
+// If choose=0, min_ass_prim_charsets with the given
+// ordering of the variables is used.
+// If choose=1, min_ass_prim_charsets with the "optimized"
+// ordering of the variables is used.
+// If choose=2, minAssPrimes from primdec.lib is used
+// If choose=3, minAssPrimes+factorizing Buchberger from primdec.lib is used
+// output: a primary decomposition of I, i.e., a list
+// of pairs consisting of a standard basis of a primary component
+// of I and a standard basis of the corresponding associated prime.
+// To compute the minimal associated primes of a given ideal
+// min_ass_prim_l is called, i.e., the minimal associated primes
+// are computed via characteristic sets.
+// In the homogeneous case, the performance of the procedure
+// will be improved if I is already given by a minimal set of
+// generators. Apply minbase if necessary.
+//////////////////////////////////////////////////////////
+
+
+static proc prim_dec(ideal I, int choose)
+{
+  if((choose<0) or (choose>3))
+  {
+    ERROR("ERROR: <int> must be 0 or 1 or 2 or 3");
+  }
+  option(notWarnSB);
+  ideal H=1; // The intersection of the primary components
+  list U;    // the leaves of the decomposition tree, i.e.,
+             // pairs consisting of a primary component of I
+             // and the corresponding associated prime
+  list W;    // the non-leaf vertices in the decomposition tree.
+             // every entry has 6 components:
+                // 1- the vertex itself , i.e., a standard bais of the
+                //    given ideal I (type 1), or a standard basis of a
+                //    pseudo-primary component arising from
+                //    pseudo-primary decomposition (type 2), or a
+                //    standard basis of a remaining component arising from
+                //    pseudo-primary decomposition or extraction (type 3)
+                // 2- the type of the vertex as indicated above
+                // 3- the weighted_tree_depth of the vertex
+                // 4- the tester of the vertex
+                // 5- a standard basis of the associated prime
+                //    of a vertex of type 2, or 0 otherwise
+                // 6- a list of pairs consisting of a standard
+                //    basis of a minimal associated prime ideal
+                //    of the father of the vertex and the
+                //    irreducible factors of the "minimal
+                //    divisor" of the seperator or extractor
+                //    corresponding to the prime ideal
+                //    as computed by the procedure minsat,
+                //    if the vertex is of type 3, or
+                //    the empty list otherwise
+  ideal SI=std(I);
+  if(SI[1]==1)  // primdecSY(ideal(1))
+  {
+    return(list());
+  }
+  int ncolsSI=ncols(SI);
+  int ncolsH=1;
+  W[1]=list(I,1,0,poly(1),ideal(0),list()); // The root of the tree
+  int weighted_tree_depth;
+  int i,j;
+  int check;
+  list V;  // current vertex
+  list VV; // new vertex
+  list QQ;
+  list WI;
+  ideal Qi,SQ,SRest,fac;
+  poly tester;
+
+  while(1)
+  {
+    i=1;
+    while(1)
+    {
+      while(i<=size(W)) // find vertex V of smallest weighted tree-depth
+      {
+        if (W[i][3]<=weighted_tree_depth) break;
+        i++;
+      }
+      if (i<=size(W)) break;
+      i=1;
+      weighted_tree_depth++;
+    }
+    V=W[i];
+    W=delete(W,i); // delete V from W
+
+    // now proceed by type of vertex V
+
+    if (V[2]==2)  // extraction needed
+    {
+      SQ,SRest,fac=extraction(V[1],V[5]);
+                        // standard basis of primary component,
+                        // standard basis of remaining component,
+                        // irreducible factors of
+                        // the "minimal divisor" of the extractor
+                        // as computed by the procedure minsat,
+      check=0;
+      for(j=1;j<=ncolsH;j++)
+      {
+        if (NF(H[j],SQ,1)!=0) // Q is not redundant
+        {
+          check=1;
+          break;
+        }
+      }
+      if(check==1)             // Q is not redundant
+      {
+        QQ=list();
+        QQ[1]=list(SQ,V[5]);  // primary component, associated prime,
+                              // i.e., standard bases thereof
+        U=U+QQ;
+        H=intersect(H,SQ);
+        H=std(H);
+        ncolsH=ncols(H);
+        check=0;
+        if(ncolsH==ncolsSI)
+        {
+          for(j=1;j<=ncolsSI;j++)
+          {
+            if(leadexp(H[j])!=leadexp(SI[j]))
+            {
+              check=1;
+              break;
+            }
+          }
+        }
+        else
+        {
+          check=1;
+        }
+        if(check==0) // H==I => U is a primary decomposition
+        {
+          return(U);
+        }
+      }
+      if (SRest[1]!=1)        // the remaining component is not
+                              // the whole ring
+      {
+        if (rad_con(V[4],SRest)==0) // the new vertex is not the
+                                    // root of a redundant subtree
+        {
+          VV[1]=SRest;     // remaining component
+          VV[2]=3;         // pseudoprimdec_special
+          VV[3]=V[3]+1;    // weighted depth
+          VV[4]=V[4];      // the tester did not change
+          VV[5]=ideal(0);
+          VV[6]=list(list(V[5],fac));
+          W=insert(W,VV,size(W));
+        }
+      }
+    }
+    else
+    {
+      if (V[2]==3) // pseudo_prim_dec_special is needed
+      {
+        QQ,SRest=pseudo_prim_dec_special_charsets(V[1],V[6],choose);
+                         // QQ = quadruples:
+                         // standard basis of pseudo-primary component,
+                         // standard basis of corresponding prime,
+                         // seperator, irreducible factors of
+                         // the "minimal divisor" of the seperator
+                         // as computed by the procedure minsat,
+                         // SRest=standard basis of remaining component
+      }
+      else     // V is the root, pseudo_prim_dec is needed
+      {
+        QQ,SRest=pseudo_prim_dec_charsets(I,SI,choose);
+                         // QQ = quadruples:
+                         // standard basis of pseudo-primary component,
+                         // standard basis of corresponding prime,
+                         // seperator, irreducible factors of
+                         // the "minimal divisor" of the seperator
+                         // as computed by the procedure minsat,
+                         // SRest=standard basis of remaining component
+
+      }
+      //check
+      for(i=size(QQ);i>=1;i--)
+      //for(i=1;i<=size(QQ);i++)
+      {
+        tester=QQ[i][3]*V[4];
+        Qi=QQ[i][2];
+        if(NF(tester,Qi,1)!=0)  // the new vertex is not the
+                                // root of a redundant subtree
+        {
+          VV[1]=QQ[i][1];
+          VV[2]=2;
+          VV[3]=V[3]+1;
+          VV[4]=tester;      // the new tester as computed above
+          VV[5]=Qi;          // QQ[i][2];
+          VV[6]=list();
+          W=insert(W,VV,size(W));
+        }
+      }
+      if (SRest[1]!=1)        // the remaining component is not
+                              // the whole ring
+      {
+        if (rad_con(V[4],SRest)==0) // the vertex is not the root
+                                    // of a redundant subtree
+        {
+          VV[1]=SRest;
+          VV[2]=3;
+          VV[3]=V[3]+2;
+          VV[4]=V[4];      // the tester did not change
+          VV[5]=ideal(0);
+          WI=list();
+          for(i=1;i<=size(QQ);i++)
+          {
+            WI=insert(WI,list(QQ[i][2],QQ[i][4]));
+          }
+          VV[6]=WI;
+          W=insert(W,VV,size(W));
+        }
+      }
+    }
+  }
+}
+
+//////////////////////////////////////////////////////////////////////////
+// proc pseudo_prim_dec_charsets
+// input: Generators of an arbitrary ideal I, a standard basis SI of I,
+// and an integer choo
+// If choo=0, min_ass_prim_charsets with the given
+// ordering of the variables is used.
+// If choo=1, min_ass_prim_charsets with the "optimized"
+// ordering of the variables is used.
+// If choo=2, minAssPrimes from primdec.lib is used
+// If choo=3, minAssPrimes+factorizing Buchberger from primdec.lib is used
+// output: a pseudo primary decomposition of I, i.e., a list
+// of pseudo primary components together with a standard basis of the
+// remaining component. Each pseudo primary component is
+// represented by a quadrupel: A standard basis of the component,
+// a standard basis of the corresponding associated prime, the
+// seperator of the component, and the irreducible factors of the
+// "minimal divisor" of the seperator as computed by the procedure minsat,
+// calls  proc pseudo_prim_dec_i
+//////////////////////////////////////////////////////////////////////////
+
+
+static proc pseudo_prim_dec_charsets (ideal I, ideal SI, int choo)
+{
+  list L;          // The list of minimal associated primes,
+                   // each one given by a standard basis
+  if((choo==0) or (choo==1))
+  {
+    L=min_ass_prim_charsets(I,choo);
+  }
+  else
+  {
+    if(choo==2)
+    {
+      L=minAssPrimes(I);
+    }
+    else
+    {
+      L=minAssPrimes(I,1);
+    }
+    for(int i=size(L);i>=1;i--)
+    {
+      L[i]=std(L[i]);
+    }
+  }
+  return (pseudo_prim_dec_i(SI,L));
+}
+
+////////////////////////////////////////////////////////////////
+// proc pseudo_prim_dec_special_charsets
+// input: a standard basis of an ideal I whose radical is the
+// intersection of the radicals of ideals generated by one prime ideal
+// P_i together with one polynomial f_i, the list V6 must be the list of
+// pairs (standard basis of P_i, irreducible factors of f_i),
+// and an integer choo
+// If choo=0, min_ass_prim_charsets with the given
+// ordering of the variables is used.
+// If choo=1, min_ass_prim_charsets with the "optimized"
+// ordering of the variables is used.
+// If choo=2, minAssPrimes from primdec.lib is used
+// If choo=3, minAssPrimes+factorizing Buchberger from primdec.lib is used
+// output: a pseudo primary decomposition of I, i.e., a list
+// of pseudo primary components together with a standard basis of the
+// remaining component. Each pseudo primary component is
+// represented by a quadrupel: A standard basis of the component,
+// a standard basis of the corresponding associated prime, the
+// seperator of the component, and the irreducible factors of the
+// "minimal divisor" of the seperator as computed by the procedure minsat,
+// calls  proc pseudo_prim_dec_i
+////////////////////////////////////////////////////////////////
+
+
+static proc pseudo_prim_dec_special_charsets (ideal SI,list V6, int choo)
+{
+  int i,j,l;
+  list m;
+  list L;
+  int sizeL;
+  ideal P,SP; ideal fac;
+  int dimSP;
+  for(l=size(V6);l>=1;l--)   // creates a list of associated primes
+                             // of I, possibly redundant
+  {
+    P=V6[l][1];
+    fac=V6[l][2];
+    for(i=ncols(fac);i>=1;i--)
+    {
+      SP=P+fac[i];
+      SP=std(SP);
+      if(SP[1]!=1)
+      {
+        if((choo==0) or (choo==1))
+        {
+          m=min_ass_prim_charsets(SP,choo);  // a list of SB
+        }
+        else
+        {
+          if(choo==2)
+          {
+            m=minAssPrimes(SP);
+          }
+          else
+          {
+            m=minAssPrimes(SP,1);
+          }
+          for(j=size(m);j>=1;j=j-1)
+            {
+              m[j]=std(m[j]);
+            }
+        }
+        dimSP=dim(SP);
+        for(j=size(m);j>=1; j--)
+        {
+          if(dim(m[j])==dimSP)
+          {
+            L=insert(L,m[j],size(L));
+          }
+        }
+      }
+    }
+  }
+  sizeL=size(L);
+  for(i=1;i<sizeL;i++)     // get rid of redundant primes
+  {
+    for(j=i+1;j<=sizeL;j++)
+    {
+      if(size(L[i])!=0)
+      {
+        if(size(L[j])!=0)
+        {
+          if(size(NF(L[i],L[j],1))==0)
+          {
+            L[j]=ideal(0);
+          }
+          else
+          {
+            if(size(NF(L[j],L[i],1))==0)
+            {
+              L[i]=ideal(0);
+            }
+          }
+        }
+      }
+    }
+  }
+  for(i=sizeL;i>=1;i--)
+  {
+    if(size(L[i])==0)
+    {
+      L=delete(L,i);
+    }
+  }
+  return (pseudo_prim_dec_i(SI,L));
+}
+
+
+////////////////////////////////////////////////////////////////
+// proc pseudo_prim_dec_i
+// input: A standard basis of an arbitrary ideal I, and standard bases
+// of the minimal associated primes of I
+// output: a pseudo primary decomposition of I, i.e., a list
+// of pseudo primary components together with a standard basis of the
+// remaining component. Each pseudo primary component is
+// represented by a quadrupel: A standard basis of the component Q_i,
+// a standard basis of the corresponding associated prime P_i, the
+// seperator of the component, and the irreducible factors of the
+// "minimal divisor" of the seperator as computed by the procedure minsat,
+////////////////////////////////////////////////////////////////
+
+
+static proc pseudo_prim_dec_i (ideal SI, list L)
+{
+  list Q;
+  if (size(L)==1)               // one minimal associated prime only
+                                // the ideal is already pseudo primary
+  {
+    Q=SI,L[1],1;
+    list QQ;
+    QQ[1]=Q;
+    return (QQ,ideal(1));
+  }
+
+  poly f0,f,g;
+  ideal fac;
+  int i,j,k,l;
+  ideal SQi;
+  ideal I'=SI;
+  list QP;
+  int sizeL=size(L);
+  for(i=1;i<=sizeL;i++)
+  {
+    fac=0;
+    for(j=1;j<=sizeL;j++)           // compute the seperator sep_i
+                                    // of the i-th component
+    {
+      if (i!=j)                       // search g not in L[i], but L[j]
+      {
+        for(k=1;k<=ncols(L[j]);k++)
+        {
+          if(NF(L[j][k],L[i],1)!=0)
+          {
+            break;
+          }
+        }
+        fac=fac+L[j][k];
+      }
+    }
+    // delete superfluous polynomials
+    fac=simplify(fac,8+2);
+    // saturation
+    SQi,f0,f,fac=minsat_ppd(SI,fac);
+    I'=I',f;
+    QP=SQi,L[i],f0,fac;
+             // the quadrupel:
+             // a standard basis of Q_i,
+             // a standard basis of P_i,
+             // sep_i,
+             // irreducible factors of
+             // the "minimal divisor" of the seperator
+             //  as computed by the procedure minsat,
+    Q[i]=QP;
+  }
+  I'=std(I');
+  return (Q, I');
+                   // I' = remaining component
+}
+
+
+////////////////////////////////////////////////////////////////
+// proc extraction
+// input: A standard basis of a pseudo primary ideal I, and a standard
+// basis of the unique minimal associated prime P of I
+// output: an extraction of I, i.e., a standard basis of the primary
+// component Q of I with associated prime P, a standard basis of the
+// remaining component, and the irreducible factors of the
+// "minimal divisor" of the extractor as computed by the procedure minsat
+////////////////////////////////////////////////////////////////
+
+
+static proc extraction (ideal SI, ideal SP)
+{
+  list indsets=indepSet(SP,0);
+  poly f;
+  if(size(indsets)!=0)      //check, whether dim P != 0
+  {
+    intvec v;               // a maximal independent set of variables
+                            // modulo P
+    string U;               // the independent variables
+    string A;               // the dependent variables
+    int j,k;
+    int a;                  //  the size of A
+    int degf;
+    ideal g;
+    list polys;
+    int sizepolys;
+    list newpoly;
+    def R=basering;
+    //intvec hv=hilb(SI,1);
+    for (k=1;k<=size(indsets);k++)
+    {
+      v=indsets[k];
+      for (j=1;j<=nvars(R);j++)
+      {
+        if (v[j]==1)
+        {
+          U=U+varstr(j)+",";
+        }
+        else
+        {
+          A=A+varstr(j)+",";
+          a++;
+        }
+      }
+
+      U[size(U)]=")";           // we compute the extractor of I (w.r.t. U)
+      execute("ring RAU=("+charstr(basering)+"),("+A+U+",(dp("+string(a)+"),dp);");
+      ideal I=imap(R,SI);
+      //I=std(I,hv);            // the standard basis in (R[U])[A]
+      I=std(I);            // the standard basis in (R[U])[A]
+      A[size(A)]=")";
+      execute("ring Rloc=("+charstr(basering)+","+U+",("+A+",dp;");
+      ideal I=imap(RAU,I);
+      //"std in lokalisierung:"+newline,I;
+      ideal h;
+      for(j=ncols(I);j>=1;j--)
+      {
+        h[j]=leadcoef(I[j]);  // consider I in (R(U))[A]
+      }
+      setring R;
+      g=imap(Rloc,h);
+      kill RAU,Rloc;
+      U="";
+      A="";
+      a=0;
+      f=lcm(g);
+      newpoly[1]=f;
+      polys=polys+newpoly;
+      newpoly=list();
+    }
+    f=polys[1];
+    degf=deg(f);
+    sizepolys=size(polys);
+    for (k=2;k<=sizepolys;k++)
+    {
+      if (deg(polys[k])<degf)
+      {
+        f=polys[k];
+        degf=deg(f);
+      }
+    }
+  }
+  else
+  {
+    f=1;
+  }
+  poly f0,h0; ideal SQ; ideal fac;
+  if(f!=1)
+  {
+    SQ,f0,h0,fac=minsat(SI,f);
+    return(SQ,std(SI+h0),fac);
+             // the tripel
+             // a standard basis of Q,
+             // a standard basis of remaining component,
+             // irreducible factors of
+             // the "minimal divisor" of the extractor
+             // as computed by the procedure minsat
+  }
+  else
+  {
+    return(SI,ideal(1),ideal(1));
+  }
+}
+
+/////////////////////////////////////////////////////
+// proc minsat
+// input:  a standard basis of an ideal I and a polynomial p
+// output: a standard basis IS of the saturation of I w.r. to p,
+// the maximal squarefree factor f0 of p,
+// the "minimal divisor" f of f0 such that the saturation of
+// I w.r. to f equals the saturation of I w.r. to f0 (which is IS),
+// the irreducible factors of f
+//////////////////////////////////////////////////////////
+
+
+static proc minsat(ideal SI, poly p)
+{
+  ideal fac=factorize(p,1);       //the irreducible factors of p
+  fac=sort(fac)[1];
+  int i,k;
+  poly f0=1;
+  for(i=ncols(fac);i>=1;i--)
+  {
+    f0=f0*fac[i];
+  }
+  poly f=1;
+  ideal iold;
+  list quotM;
+  quotM[1]=SI;
+  quotM[2]=fac;
+  quotM[3]=f0;
+  // we deal seperately with the first quotient;
+  // factors, which do not contribute to this one,
+  // are omitted
+  iold=quotM[1];
+  quotM=minquot(quotM);
+  fac=quotM[2];
+  if(quotM[3]==1)
+    {
+      return(quotM[1],f0,f,fac);
+    }
+  while(special_ideals_equal(iold,quotM[1])==0)
+    {
+      f=f*quotM[3];
+      iold=quotM[1];
+      quotM=minquot(quotM);
+    }
+  return(quotM[1],f0,f,fac);           // the quadrupel ((I:p),f0,f, irr. factors of f)
+}
+
+/////////////////////////////////////////////////////
+// proc minsat_ppd
+// input:  a standard basis of an ideal I and a polynomial p
+// output: a standard basis IS of the saturation of I w.r. to p,
+// the maximal squarefree factor f0 of p,
+// the "minimal divisor" f of f0 such that the saturation of
+// I w.r. to f equals the saturation of I w.r. to f0 (which is IS),
+// the irreducible factors of f
+//////////////////////////////////////////////////////////
+
+
+static proc minsat_ppd(ideal SI, ideal fac)
+{
+  fac=sort(fac)[1];
+  int i,k;
+  poly f0=1;
+  for(i=ncols(fac);i>=1;i--)
+  {
+    f0=f0*fac[i];
+  }
+  poly f=1;
+  ideal iold;
+  list quotM;
+  quotM[1]=SI;
+  quotM[2]=fac;
+  quotM[3]=f0;
+  // we deal seperately with the first quotient;
+  // factors, which do not contribute to this one,
+  // are omitted
+  iold=quotM[1];
+  quotM=minquot(quotM);
+  fac=quotM[2];
+  if(quotM[3]==1)
+    {
+      return(quotM[1],f0,f,fac);
+    }
+  while(special_ideals_equal(iold,quotM[1])==0)
+  {
+    f=f*quotM[3];
+    iold=quotM[1];
+    quotM=minquot(quotM);
+    k++;
+  }
+  return(quotM[1],f0,f,fac);           // the quadrupel ((I:p),f0,f, irr. factors of f)
+}
+/////////////////////////////////////////////////////////////////
+// proc minquot
+// input: a list with 3 components: a standard basis
+// of an ideal I, a set of irreducible polynomials, and
+// there product f0
+// output: a standard basis of the ideal (I:f0), the irreducible
+// factors of the "minimal divisor" f of f0 with (I:f0) = (I:f),
+// the "minimal divisor" f
+/////////////////////////////////////////////////////////////////
+
+static proc minquot(list tsil)
+{
+   intvec op;
+   int i,j,k,action;
+   ideal verg;
+   list l;
+   poly g;
+   ideal laedi=tsil[1];
+   ideal fac=tsil[2];
+   poly f=tsil[3];
+
+//std
+//   ideal star=quotient(laedi,f);
+//   star=std(star);
+   op=option(get);
+   option(returnSB);
+   ideal star=quotient(laedi,f);
+   option(set,op);
+   if(special_ideals_equal(laedi,star)==1)
+     {
+       return(laedi,ideal(1),1);
+     }
+   action=1;
+   while(action==1)
+   {
+      if(size(fac)==1)
+      {
+         action=0;
+         break;
+      }
+      for(i=1;i<=size(fac);i++)
+      {
+        g=1;
+         for(j=1;j<=size(fac);j++)
+         {
+            if(i!=j)
+            {
+               g=g*fac[j];
+            }
+         }
+//std
+//         verg=quotient(laedi,g);
+//         verg=std(verg);
+         op=option(get);
+         option(returnSB);
+         verg=quotient(laedi,g);
+         option(set,op);
+         if(special_ideals_equal(verg,star)==1)
+         {
+            f=g;
+            fac[i]=0;
+            fac=simplify(fac,2);
+            break;
+         }
+         if(i==size(fac))
+         {
+            action=0;
+         }
+      }
+   }
+   l=star,fac,f;
+   return(l);
+}
+/////////////////////////////////////////////////
+// proc special_ideals_equal
+// input: standard bases of ideal k1 and k2 such that
+// k1 is contained in k2, or k2 is contained ink1
+// output: 1, if k1 equals k2, 0 otherwise
+//////////////////////////////////////////////////
+
+static proc special_ideals_equal( ideal k1, ideal k2)
+{
+   int j;
+   if(size(k1)==size(k2))
+   {
+      for(j=1;j<=size(k1);j++)
+      {
+         if(leadexp(k1[j])!=leadexp(k2[j]))
+         {
+            return(0);
+         }
+      }
+      return(1);
+   }
+   return(0);
+}
+
+
+///////////////////////////////////////////////////////////////////////////////
+
+static proc convList(list l)
+{
+   int i;
+   list re,he;
+   for(i=1;i<=size(l)/2;i++)
+   {
+      he=l[2*i-1],l[2*i];
+      re[i]=he;
+   }
+   return(re);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+static proc reconvList(list l)
+{
+   int i;
+   list re;
+   for(i=1;i<=size(l);i++)
+   {
+      re[2*i-1]=l[i][1];
+      re[2*i]=l[i][2];
+   }
+   return(re);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+//
+//     The main procedures
+//
+///////////////////////////////////////////////////////////////////////////////
+
+proc primdecGTZ(ideal i)
+"USAGE:   primdecGTZ(i); i ideal
+RETURN:  a list pr of primary ideals and their associated primes:
+@format
+   pr[i][1]   the i-th primary component,
+   pr[i][2]   the i-th prime component.
+@end format
+NOTE:    Algorithm of Gianni/Trager/Zacharias.
+         Designed for characteristic 0, works also in char k > 0, if it
+         terminates (may result in an infinite loop in small characteristic!)
+EXAMPLE: example primdecGTZ; shows an example
+"
+{
+   if(attrib(basering,"global")!=1)
+   {
+      ERROR(
+      "// Not implemented for this ordering, please change to global ordering."
+      );
+   }
+   if(minpoly!=0)
+   {
+      return(algeDeco(i,0));
+      ERROR(
+      "// Not implemented yet for algebraic extensions.Simulate the ring extension by adding the minpoly to the ideal"
+      );
+   }
+  return(convList(decomp(i)));
+}
+example
+{ "EXAMPLE:";  echo = 2;
+   ring  r = 0,(x,y,z),lp;
+   poly  p = z2+1;
+   poly  q = z3+2;
+   ideal i = p*q^2,y-z2;
+   list pr = primdecGTZ(i);
+   pr;
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc absPrimdecGTZ(ideal I)
+"USAGE:   absPrimdecGTZ(I); I ideal
+ASSUME:  Ground field has characteristic 0.
+RETURN:  a ring containing two lists: @code{absolute_primes} (the absolute
+         prime components of I) and @code{primary_decomp} (the output of
+         @code{primdecGTZ(I)}).
+         The list absolute_primes has to be interpreted as follows:
+         each entry describes a class of conjugated absolute primes,
+@format
+   absolute_primes[i][1]   the absolute prime component,
+   absolute_primes[i][2]   the number of conjugates.
+@end format
+         The first entry of @code{absolute_primes[i][1]} is the minimal
+         polynomial of a minimal finite field extension over which the
+         absolute prime component is defined.
+NOTE:    Algorithm of Gianni/Trager/Zacharias combined with the
+         @code{absFactorize} command.
+SEE ALSO: primdecGTZ; absFactorize
+EXAMPLE: example absPrimdecGTZ; shows an example
+"
+{
+  if (char(basering) != 0)
+  {
+    ERROR("primdec.lib::absPrimdecGTZ is only implemented for "+
+           +"characteristic 0");
+  }
+
+  if(attrib(basering,"global")!=1)
+  {
+    ERROR(
+      "// Not implemented for this ordering, please change to global ordering."
+    );
+  }
+  if(minpoly!=0)
+  {
+    //return(algeDeco(i,0));
+    ERROR(
+      "// Not implemented yet for algebraic extensions.Simulate the ring extension by adding the minpoly to the ideal"
+    );
+  }
+  def R=basering;
+  int n=nvars(R);
+  list L=decomp(I,3);
+  string newvar=L[1][3];
+  int k=find(newvar,",",find(newvar,",")+1);
+  newvar=newvar[k+1..size(newvar)];
+  list lR=ringlist(R);
+  int i,d;
+  intvec vv;
+  for(i=1;i<=n;i++){vv[i]=1;}
+
+  list orst;
+  orst[1]=list("dp",vv);
+  orst[2]=list("dp",intvec(1));
+  orst[3]=list("C",0);
+  lR[3]=orst;
+  lR[2][n+1] = newvar;
+  def Rz = ring(lR);
+  setring Rz;
+  list L=imap(R,L);
+  list absolute_primes,primary_decomp;
+  ideal I,M,N,K;
+  M=maxideal(1);
+  N=maxideal(1);
+  poly p,q,f,g;
+  map phi,psi;
+  for(i=1;i<=size(L);i++)
+  {
+    I=L[i][2];
+    execute("K="+L[i][3]+";");
+    p=K[1];
+    q=K[2];
+    execute("f="+L[i][4]+";");
+    g=2*var(n)-f;
+    M[n]=f;
+    N[n]=g;
+    d=deg(p);
+    phi=Rz,M;
+    psi=Rz,N;
+    I=phi(I),p,q;
+    I=std(I);
+    absolute_primes[i]=list(psi(I),d);
+    primary_decomp[i]=list(L[i][1],L[i][2]);
+  }
+  export(primary_decomp);
+  export(absolute_primes);
+  setring R;
+  dbprint( printlevel-voice+3,"
+// 'absPrimdecGTZ' created a ring, in which two lists absolute_primes (the
+// absolute prime components) and primary_decomp (the primary and prime
+// components over the current basering) are stored.
+// To access the list of absolute prime components, type (if the name S was
+// assigned to the return value):
+        setring S; absolute_primes; ");
+
+  return(Rz);
+}
+example
+{ "EXAMPLE:";  echo = 2;
+   ring  r = 0,(x,y,z),lp;
+   poly  p = z2+1;
+   poly  q = z3+2;
+   ideal i = p*q^2,y-z2;
+   def S = absPrimdecGTZ(i);
+   setring S;
+   absolute_primes;
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc primdecSY(ideal i, list #)
+"USAGE:   primdecSY(I, c); I ideal, c int (optional)
+RETURN:  a list pr of primary ideals and their associated primes:
+@format
+   pr[i][1]   the i-th primary component,
+   pr[i][2]   the i-th prime component.
+@end format
+NOTE:    Algorithm of Shimoyama/Yokoyama.
+@format
+   if c=0,  the given ordering of the variables is used,
+   if c=1,  minAssChar tries to use an optimal ordering (default),
+   if c=2,  minAssGTZ is used,
+   if c=3,  minAssGTZ and facstd are used.
+@end format
+EXAMPLE: example primdecSY; shows an example
+"
+{
+   if(attrib(basering,"global")!=1)
+   {
+      ERROR(
+      "// Not implemented for this ordering, please change to global ordering."
+      );
+   }
+   i=simplify(i,2);
+   if ((i[1]==0)||(i[1]==1))
+   {
+     list L=list(ideal(i[1]),ideal(i[1]));
+     return(list(L));
+   }
+   if(minpoly!=0)
+   {
+      return(algeDeco(i,1));
+   }
+   if (size(#)==1)
+   { return(prim_dec(i,#[1])); }
+   else
+   { return(prim_dec(i,1)); }
+}
+example
+{ "EXAMPLE:";  echo = 2;
+   ring  r = 0,(x,y,z),lp;
+   poly  p = z2+1;
+   poly  q = z3+2;
+   ideal i = p*q^2,y-z2;
+   list pr = primdecSY(i);
+   pr;
+}
+///////////////////////////////////////////////////////////////////////////////
+proc minAssGTZ(ideal i,list #)
+"USAGE:    minAssGTZ(I[, l]); I ideal, l list (optional)
+   @* Optional parameters in list l (can be entered in any order):
+   @* 0, \"facstd\" -> uses facstd to first decompose the ideal (default)
+   @* 1, \"noFacstd\" -> does not use facstd
+   @* \"GTZ\" -> the original algorithm by Gianni, Trager and Zacharias is used
+   @* \"SL\" -> GTZ algorithm with modificiations by Laplagne is used (default)
+
+RETURN:  a list, the minimal associated prime ideals of I.
+NOTE:    Designed for characteristic 0, works also in char k > 0 based
+         on an algorithm of Yokoyama
+EXAMPLE: example minAssGTZ; shows an example
+"
+{
+  int j;
+  string algorithm;
+  string facstdOption;
+  int useFac;
+
+  // Set input parameters
+  algorithm = "SL";         // Default: SL algorithm
+  facstdOption = "facstd";
+  if(size(#) > 0)
+  {
+    int valid;
+    for(j = 1; j <= size(#); j++)
+    {
+      valid = 0;
+      if((typeof(#[j]) == "int") or (typeof(#[j]) == "number"))
+      {
+        if (#[j] == 1) {facstdOption = "noFacstd"; valid = 1;}    // If #[j] == 1, facstd is not used.
+        if (#[j] == 0) {facstdOption = "facstd";   valid = 1;}    // If #[j] == 0, facstd is used.
+      }
+      if(typeof(#[j]) == "string")
+      {
+        if((#[j] == "GTZ") || (#[j] == "SL"))
+        {
+          algorithm = #[j];
+          valid = 1;
+        }
+        if((#[j] == "noFacstd") || (#[j] == "facstd"))
+        {
+          facstdOption = #[j];
+          valid = 1;
+        }
+      }
+      if(valid == 0)
+      {
+        dbprint(1, "Warning! The following input parameter was not recognized:", #[j]);
+      }
+    }
+  }
+
+  if(attrib(basering,"global")!=1)
+  {
+    ERROR(
+      "// Not implemented for this ordering, please change to global ordering."
+    );
+  }
+  if(minpoly!=0)
+  {
+    return(algeDeco(i,2));
+  }
+
+  list result = minAssPrimes(i, facstdOption, algorithm);
+  return(result);
+}
+example
+{ "EXAMPLE:";  echo = 2;
+   ring  r = 0,(x,y,z),dp;
+   poly  p = z2+1;
+   poly  q = z3+2;
+   ideal i = p*q^2,y-z2;
+   list pr = minAssGTZ(i);
+   pr;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+proc minAssChar(ideal i, list #)
+"USAGE:   minAssChar(I[,c]); i ideal, c int (optional).
+RETURN:  list, the minimal associated prime ideals of i.
+NOTE:    If c=0, the given ordering of the variables is used. @*
+         Otherwise, the system tries to find an optimal ordering,
+         which in some cases may considerably speed up the algorithm. @*
+         Due to a bug in the factorization, the result may be not completely
+         decomposed in small characteristic.
+EXAMPLE: example minAssChar; shows an example
+"
+{
+   if(attrib(basering,"global")!=1)
+   {
+      ERROR(
+      "// Not implemented for this ordering, please change to global ordering."
+      );
+   }
+   if (size(#)==1)
+   { return(min_ass_prim_charsets(i,#[1])); }
+   else
+   { return(min_ass_prim_charsets(i,1)); }
+}
+example
+{ "EXAMPLE:";  echo = 2;
+   ring  r = 0,(x,y,z),dp;
+   poly  p = z2+1;
+   poly  q = z3+2;
+   ideal i = p*q^2,y-z2;
+   list pr = minAssChar(i);
+   pr;
+}
+///////////////////////////////////////////////////////////////////////////////
+proc equiRadical(ideal i)
+"USAGE:   equiRadical(I); I ideal
+RETURN:  ideal, intersection of associated primes of I of maximal dimension.
+NOTE:    A combination of the algorithms of Krick/Logar (with modifications by Laplagne) and Kemper is used.
+         Works also in positive characteristic (Kempers algorithm).
+EXAMPLE: example equiRadical; shows an example
+"
+{
+  if(attrib(basering,"global")!=1)
+  {
+     ERROR(
+     "// Not implemented for this ordering, please change to global ordering."
+     );
+  }
+  return(radical(i, 1));
+}
+example
+{ "EXAMPLE:";  echo = 2;
+   ring  r = 0,(x,y,z),dp;
+   poly  p = z2+1;
+   poly  q = z3+2;
+   ideal i = p*q^2,y-z2;
+   ideal pr= equiRadical(i);
+   pr;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+proc radical(ideal i, list #)
+"USAGE: radical(I[, l]); I ideal, l list (optional)
+ @*  Optional parameters in list l (can be entered in any order):
+ @*  0, \"fullRad\" -> full radical is computed (default)
+ @*  1, \"equiRad\" -> equiRadical is computed
+ @*  \"KL\" -> Krick/Logar algorithm is used
+ @*  \"SL\" -> modifications by Laplagne are used (default)
+ @*  \"facstd\" -> uses facstd to first decompose the ideal (default for non homogeneous ideals)
+ @*  \"noFacstd\" -> does not use facstd (default for homogeneous ideals)
+RETURN:  ideal, the radical of I (or the equiradical if required in the input parameters)
+NOTE:    A combination of the algorithms of Krick/Logar (with modifications by Laplagne) and Kemper is used.
+         Works also in positive characteristic (Kempers algorithm).
+EXAMPLE: example radical; shows an example
+"
+{
+  dbprint(printlevel - voice, "Radical, version 2006.05.08");
+  if(attrib(basering,"global")!=1)
+  {
+    ERROR(
+     "// Not implemented for this ordering, please change to global ordering."
+    );
+  }
+  if(size(i) == 0){return(ideal(0));}
+  int j;
+  def P0 = basering;
+  list Pl=ringlist(P0);
+  intvec dp_w;
+  for(j=nvars(P0);j>0;j--) {dp_w[j]=1;}
+  Pl[3]=list(list("dp",dp_w),list("C",0));
+  def @P=ring(Pl);
+  setring @P;
+  ideal i=imap(P0,i);
+
+  int il;
+  string algorithm;
+  int useFac;
+
+  // Set input parameters
+  algorithm = "SL";                                 // Default: SL algorithm
+  il = 0;                                           // Default: Full radical (not only equiRadical)
+  if (homog(i) == 1)
+  {   // Default: facStd is used, except if the ideal is homogeneous.
+    useFac = 0;
+  }
+  else
+  {
+    useFac = 1;
+  }
+  if(size(#) > 0)
+  {
+    int valid;
+    for(j = 1; j <= size(#); j++)
+    {
+      valid = 0;
+      if((typeof(#[j]) == "int") or (typeof(#[j]) == "number"))
+      {
+        il = #[j];          // If il == 1, equiRadical is computed
+        valid = 1;
+      }
+      if(typeof(#[j]) == "string")
+      {
+        if(#[j] == "KL")
+        {
+          algorithm = "KL";
+          valid = 1;
+        }
+        if(#[j] == "SL")
+        {
+          algorithm = "SL";
+          valid = 1;
+        }
+        if(#[j] == "noFacstd")
+        {
+          useFac = 0;
+          valid = 1;
+        }
+        if(#[j] == "facstd")
+        {
+          useFac = 1;
+          valid = 1;
+        }
+        if(#[j] == "equiRad")
+        {
+          il = 1;
+          valid = 1;
+        }
+        if(#[j] == "fullRad")
+        {
+          il = 0;
+          valid = 1;
+        }
+      }
+      if(valid == 0)
+      {
+        dbprint(1, "Warning! The following input parameter was not recognized:", #[j]);
+      }
+    }
+  }
+
+  ideal rad = 1;
+  intvec op = option(get);
+  list qr = simplifyIdeal(i);
+  map phi = @P, qr[2];
+
+  option(redSB);
+  i = groebner(qr[1]);
+  option(set, op);
+  int di = dim(i);
+
+  if(di == 0)
+  {
+    i = zeroRad(i, qr[1]);
+    i=interred(phi(i));
+    setring(P0);
+    i=imap(@P,i);
+    return(i);
+  }
+
+  option(redSB);
+  list pr;
+  if(useFac == 1)
+  {
+    pr = facstd(i);
+  }
+  else
+  {
+    pr = i;
+  }
+  option(set, op);
+  int s = size(pr);
+  if(useFac == 1)
+  {
+    dbprint(printlevel - voice, "Number of components returned by facstd: ", s);
+  }
+  for(j = 1; j <= s; j++)
+  {
+    attrib(pr[s + 1 - j], "isSB", 1);
+    if((size(reduce(rad, pr[s + 1 - j], 1)) != 0) && ((dim(pr[s + 1 - j]) == di) || !il))
+    {
+      // SL Debug messages
+      dbprint(printlevel-voice, "We shall compute the radical of ", pr[s + 1 - j]);
+      dbprint(printlevel-voice, "The dimension is: ", dim(pr[s+1-j]));
+
+      if(algorithm == "KL")
+      {
+        rad = intersect(rad, radicalKL(pr[s + 1 - j], rad, il));
+      }
+      if(algorithm == "SL")
+      {
+        rad = intersect(rad, radicalSL(pr[s + 1 - j], il));
+      }
+    }
+    else
+    {
+      // SL Debug
+      dbprint(printlevel-voice, "The radical of this component is not needed.");
+      dbprint(printlevel-voice, "size(reduce(rad, pr[s + 1 - j], 1))",
+              size(reduce(rad, pr[s + 1 - j], 1)));
+      dbprint(printlevel-voice, "dim(pr[s + 1 - j])", dim(pr[s + 1 - j]));
+      dbprint(printlevel-voice, "il", il);
+    }
+  }
+  rad=interred(phi(rad));
+  setring(P0);
+  i=imap(@P,rad);
+  return(i);
+}
+example
+{ "EXAMPLE:";  echo = 2;
+   ring  r = 0,(x,y,z),dp;
+   poly  p = z2+1;
+   poly  q = z3+2;
+   ideal i = p*q^2,y-z2;
+   ideal pr = radical(i);
+   pr;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+//
+// Computes the radical of I using KL algorithm.
+// The only difference with the the previous implementation of KL algorithm is
+// that now it uses block dp instead of lp ordering for the reduction to the
+// zerodimensional case.
+// The reduction step has been moved to the new routine radicalReduction, so that it can be
+// used also by radicalSL procedure.
+//
+static proc radicalKL(ideal I, ideal ser, list #)
+{
+// ideal I     The ideal for which the radical is computed
+// ideal ser   Used to reduce components already obtained
+// list #      If #[1] = 1, equiradical is computed.
+
+  // I needs to be a Groebner basis.
+  if (attrib(I, "isSB") != 1)
+  {
+    I = groebner(I);
+  }
+
+  ideal rad;                                // The radical
+  int allIndep = 1;                // All max independent sets are used
+
+  list result = radicalReduction(I, ser, allIndep, #);
+  int done = result[3];
+  rad = result[1];
+  if (done == 0)
+  {
+    rad = intersect(rad, radicalKL(result[2], ideal(1), #));
+  }
+  return(rad);
+}
+
+
+///////////////////////////////////////////////////////////////////////////////
+//
+// Computes the radical of I via Laplagne algorithm, using zerodimensional radical in
+// the zero dimensional case.
+// For the reduction to the zerodimensional case, it uses the procedure
+// radical, with some modifications to avoid the recursion.
+//
+static proc radicalSL(ideal I, list #)
+// Input = I, ideal
+//         #, list. If #[1] = 1, then computes only the equiradical.
+// Output = (P, primaryDec) where P = rad(I) and primaryDec is the list of the radicals
+// obtained in intermediate steps.
+{
+  ideal rad = 1;
+  ideal equiRad = 1;
+  list primes;
+  int k;                        // Counter
+  int il;                 // If il = 1, only the equiradical is required.
+  int iDim;                // The dimension of I
+  int stop = 0;   // Checks if the radical has been obtained
+
+  if (attrib(I, "isSB") != 1)
+  {
+    I = groebner(I);
+  }
+  iDim = dim(I);
+
+  // Checks if only equiradical is required
+  if (size(#) > 0)
+  {
+    il = #[1];
+  }
+
+  while(stop == 0)
+  {
+    dbprint (printlevel-voice, "// We call radLoopR to find new prime ideals.");
+    primes = radicalSLIteration(I, rad);                         // A list of primes or intersections of primes, not included in P
+    dbprint (printlevel - voice, "// Output of Iteration Step:");
+    dbprint (printlevel - voice, primes);
+    if (size(primes) > 0)
+    {
+      dbprint (printlevel - voice, "// We intersect P with the ideal just obtained.");
+      for(k = 1; k <= size(primes); k++)
+      {
+        rad = intersect(rad, primes[k]);
+        if (il == 1)
+        {
+          if (attrib(primes[k], "isSB") != 1)
+          {
+            primes[k] = groebner(primes[k]);
+          }
+          if (iDim == dim(primes[k]))
+          {
+            equiRad = intersect(equiRad, primes[k]);
+          }
+        }
+      }
+    }
+    else
+    {
+      stop = 1;
+    }
+  }
+  if (il == 0)
+  {
+    return(rad);
+  }
+  else
+  {
+    return(equiRad);
+  }
+}
+
+//////////////////////////////////////////////////////////////////////////
+// Based on radicalKL.
+// It contains all of old version of proc radicalKL except the recursion call.
+//
+// Output:
+// #1 -> output ideal, the part of the radical that has been computed
+// #2 -> complementary ideal, the part of the ideal I whose radical remains to be computed
+//       = (I, h) in KL algorithm
+//       This is not used in the new algorithm. It is part of KL algorithm
+// #3 -> done, 1: output = radical, there is no need to continue
+//                   0: radical = output \cap \sqrt{complementary ideal}
+//       This is not used in the new algorithm. It is part of KL algorithm
+
+static proc radicalReduction(ideal I, ideal ser, int allIndep, list #)
+{
+// allMaximal                1 -> Indicates that the reduction to the zerodim case
+//                       must be done for all indep set of the leading terms ideal
+//                                        0 -> Otherwise
+// ideal ser                Only for radicalKL. (Same as in radicalKL)
+// list #                        Only for radicalKL (If #[1] = 1, only equiradical is required.
+//                  It is used to set the value of done.)
+
+  attrib(I, "isSB", 1);   // I needs to be a reduced standard basis
+  list indep, fett;
+  intvec @w, @hilb, op;
+  int @wr, @n, @m, lauf, di;
+  ideal fac, @h, collectrad, lsau;
+  poly @q;
+  string @va, quotring;
+
+  def @P = basering;
+  int jdim = dim(I);               // Computes the dimension of I
+  int  homo = homog(I);            // Finds out if I is homogeneous
+  ideal rad = ideal(1);            // The unit ideal
+  ideal te = ser;
+  if(size(#) > 0)
+  {
+    @wr = #[1];
+  }
+  if(homo == 1)
+  {
+    for(@n = 1; @n <= nvars(basering); @n++)
+    {
+      @w[@n] = ord(var(@n));
+    }
+    @hilb = hilb(I, 1, @w);
+  }
+
+  // SL 2006.04.11 1 Debug messages
+  dbprint(printlevel-voice, "//Computes the radical of the ideal:", I);
+  // SL 2006.04.11 2 Debug messages
+
+  //---------------------------------------------------------------------------
+  //j is the ring
+  //---------------------------------------------------------------------------
+
+  if (jdim==-1)
+  {
+    return(ideal(1), ideal(1), 1);
+  }
+
+  //---------------------------------------------------------------------------
+  //the zero-dimensional case
+  //---------------------------------------------------------------------------
+
+  if (jdim==0)
+  {
+    return(zeroRad(I), ideal(1), 1);
+  }
+
+  //-------------------------------------------------------------------------
+  //search for a maximal independent set indep,i.e.
+  //look for subring such that the intersection with the ideal is zero
+  //j intersected with K[var(indep[3]+1),...,var(nvar)] is zero,
+  //indep[1] is the new varstring, indep[2] the string for the block-ordering
+  //-------------------------------------------------------------------------
+
+  // SL 2006-04-24 1         If allIndep = 0, then it only computes one maximal
+  //                                        independent set.
+  //                                        This looks better for the new algorithm but not for KL
+  //                                        algorithm
+  list parameters = allIndep;
+  indep = newMaxIndependSetDp(I, parameters);
+  // SL 2006-04-24 2
+
+  for(@m = 1; @m <= size(indep); @m++)
+  {
+    if((indep[@m][1] == varstr(basering)) && (@m == 1))
+    //this is the good case, nothing to do, just to have the same notations
+    //change the ring
+    {
+      execute("ring gnir1 = ("+charstr(basering)+"),("+varstr(basering)+"),("
+                              +ordstr(basering)+");");
+      ideal @j = fetch(@P, I);
+      attrib(@j, "isSB", 1);
+    }
+    else
+    {
+      @va = string(maxideal(1));
+
+      execute("ring gnir1 = (" + charstr(basering) + "), (" + indep[@m][1] + "),("
+                              + indep[@m][2] + ");");
+      execute("map phi = @P," + @va + ";");
+      if(homo == 1)
+      {
+        ideal @j = std(phi(I), @hilb, @w);
+      }
+      else
+      {
+        ideal @j = groebner(phi(I));
+      }
+    }
+    if((deg(@j[1]) == 0) || (dim(@j) < jdim))
+    {
+      setring @P;
+      break;
+    }
+    for (lauf = 1; lauf <= size(@j); lauf++)
+    {
+      fett[lauf] = size(@j[lauf]);
+    }
+    //------------------------------------------------------------------------
+    // We have now the following situation:
+    // j intersected with K[var(nnp+1),..,var(nva)] is zero so we may pass
+    // to this quotientring, j is there still a standardbasis, the
+    // leading coefficients of the polynomials there (polynomials in
+    // K[var(nnp+1),..,var(nva)]) are collected in the list h,
+    // we need their LCM, gh, because of the following:
+    // let (j:gh^n)=(j:gh^infinity) then j*K(var(nnp+1),..,var(nva))[..rest..]
+    // intersected with K[var(1),...,var(nva)] is (j:gh^n)
+    // on the other hand j = ((j, gh^n) intersected with (j : gh^n))
+
+    //------------------------------------------------------------------------
+    // The arrangement for the quotientring K(var(nnp+1),..,var(nva))[..rest..]
+    // and the map phi:K[var(1),...,var(nva)] ----->
+    // K(var(nnpr+1),..,var(nva))[..the rest..]
+    //------------------------------------------------------------------------
+    quotring = prepareQuotientRingDp(nvars(basering) - indep[@m][3]);
+    //------------------------------------------------------------------------
+    // We pass to the quotientring   K(var(nnp+1),..,var(nva))[..the rest..]
+    //------------------------------------------------------------------------
+
+    execute(quotring);
+
+    // @j considered in the quotientring
+    ideal @j = imap(gnir1, @j);
+
+    kill gnir1;
+
+    // j is a standardbasis in the quotientring but usually not minimal
+    // here it becomes minimal
+
+    @j = clearSB(@j, fett);
+
+    // We need later LCM(h[1],...) = gh for saturation
+    ideal @h;
+    if(deg(@j[1]) > 0)
+    {
+      for(@n = 1; @n <= size(@j); @n++)
+      {
+        @h[@n] = leadcoef(@j[@n]);
+      }
+      op = option(get);
+      option(redSB);
+      @j = interred(@j);  //to obtain a reduced standardbasis
+      attrib(@j, "isSB", 1);
+      option(set, op);
+
+      // SL 1 Debug messages
+      dbprint(printlevel - voice, "zero_rad", basering, @j, dim(groebner(@j)));
+      ideal zero_rad = zeroRad(@j);
+      dbprint(printlevel - voice, "zero_rad passed");
+      // SL 2
+    }
+    else
+    {
+      ideal zero_rad = ideal(1);
+    }
+
+    // We need the intersection of the ideals in the list quprimary with the
+    // polynomialring, i.e. let q=(f1,...,fr) in the quotientring such an ideal
+    // but fi polynomials, then the intersection of q with the polynomialring
+    // is the saturation of the ideal generated by f1,...,fr with respect to
+    // h which is the lcm of the leading coefficients of the fi considered in
+    // the quotientring: this is coded in saturn
+
+    zero_rad = std(zero_rad);
+
+    ideal hpl;
+
+    for(@n = 1; @n <= size(zero_rad); @n++)
+    {
+      hpl = hpl, leadcoef(zero_rad[@n]);
+    }
+
+    //------------------------------------------------------------------------
+    // We leave  the quotientring   K(var(nnp+1),..,var(nva))[..the rest..]
+    // back to the polynomialring
+    //------------------------------------------------------------------------
+    setring @P;
+
+    collectrad = imap(quring, zero_rad);
+    lsau = simplify(imap(quring, hpl), 2);
+    @h = imap(quring, @h);
+
+    kill quring;
+
+    // Here the intersection with the polynomialring
+    // mentioned above is really computed
+
+    collectrad = sat2(collectrad, lsau)[1];
+    if(deg(@h[1])>=0)
+    {
+      fac = ideal(0);
+      for(lauf = 1; lauf <= ncols(@h); lauf++)
+      {
+        if(deg(@h[lauf]) > 0)
+        {
+          fac = fac + factorize(@h[lauf], 1);
+        }
+      }
+      fac = simplify(fac, 6);
+      @q = 1;
+      for(lauf = 1; lauf <= size(fac); lauf++)
+      {
+        @q = @q * fac[lauf];
+      }
+      op = option(get);
+      option(returnSB);
+      option(redSB);
+      I = quotient(I + ideal(@q), rad);
+      attrib(I, "isSB", 1);
+      option(set, op);
+    }
+    if((deg(rad[1]) > 0) && (deg(collectrad[1]) > 0))
+    {
+      rad = intersect(rad, collectrad);
+      te = intersect(te, collectrad);
+      te = simplify(reduce(te, I, 1), 2);
+    }
+    else
+    {
+      if(deg(collectrad[1]) > 0)
+      {
+        rad = collectrad;
+        te = intersect(te, collectrad);
+        te = simplify(reduce(te, I, 1), 2);
+      }
+    }
+
+    if((dim(I) < jdim)||(size(te) == 0))
+    {
+      break;
+    }
+    if(homo==1)
+    {
+      @hilb = hilb(I, 1, @w);
+    }
+  }
+
+  // SL 2006.04.11 1 Debug messages
+  dbprint (printlevel-voice, "// Part of the Radical already computed:", rad);
+  dbprint (printlevel-voice, "// Dimension:", dim(groebner(rad)));
+  // SL 2006.04.11 2 Debug messages
+
+  // SL 2006.04.21 1         New variable "done".
+  //                                        It tells if the radical is already computed or
+  //                                        if it still has to be computed the radical of the new ideal I
+  int done;
+  if(((@wr == 1) && (dim(I)<jdim)) || (deg(I[1])==0) || (size(te) == 0))
+  {
+    done = 1;
+  }
+  else
+  {
+    done = 0;
+  }
+  // SL 2006.04.21 2
+
+  // SL 2006.04.21 1         See details of the output at the beggining of this proc.
+  list result = rad, I, done;
+  return(result);
+  // SL 2006.04.21 2
+}
+
+
+
+///////////////////////////////////////////////////////////////////////////////
+// Given an ideal I and an ideal P (intersection of some minimal prime ideals
+// associated to I), it calculates the intersection of new minimal prime ideals
+// associated to I which where not used to calculate P.
+// This version uses ZD Radical in the zerodimensional case.
+static proc radicalSLIteration (ideal I, ideal P);
+// Input: I, ideal. The ideal from which new prime components will be obtained.
+//        P, ideal. Intersection of some prime ideals of I.
+// Output: ideal. Intersection of some primes of I different from the ones in P.
+{
+  int k = 1;                                // Counter
+  int good  = 0;                        // Checks if an element of P is in rad(I)
+
+  dbprint (printlevel-voice, "// We search for an element in P - sqrt(I).");
+  while ((k <= size(P)) and (good == 0))
+  {
+    dbprint (printlevel-voice, "// We try with:", P[k]);
+    good = 1 - rad_con(P[k], I);
+    k++;
+  }
+  k--;
+  if (good == 0)
+  {
+    dbprint (printlevel-voice, "// No element was found, P = sqrt(I).");
+    list emptyList = list();
+    return (emptyList);
+  }
+  dbprint(printlevel - voice, "// That one was good!");
+  dbprint(printlevel - voice, "// We saturate I with respect to this element.");
+  if (P[k] != 1)
+  {
+    ideal J = sat(I, P[k])[1];
+  }
+  else
+  {
+    dbprint(printlevel - voice, "// The polynomial is 1, the saturation in not actually computed.");
+    ideal J = I;
+  }
+
+  // We now call proc radicalNew;
+  dbprint(printlevel - voice, "// We do the reduction to the zerodimensional case, via radical.");
+  dbprint(printlevel - voice, "// The ideal is ", J);
+  dbprint(printlevel - voice, "// The dimension is ", dim(groebner(J)));
+
+  int allMaximal = 0;                   // Compute the zerodim reduction for only one indep set.
+  ideal re = 1;                           // No reduction is need, there are not redundant components.
+  list emptyList = list();   // Look for primes of any dimension, not only of max dimension.
+  list result = radicalReduction(J, re, allMaximal, emptyList);
+
+  return(result[1]);
+}
+
+///////////////////////////////////////////////////////////////////////////////////
+// Based on maxIndependSet
+// Added list # as parameter
+// If the first element of # is 0, the output is only 1 max indep set.
+// If no list is specified or #[1] = 1, the output is all the max indep set of the
+// leading terms ideal. This is the original output of maxIndependSet
+
+// The ordering given in the output has been changed to block dp instead of lp.
+
+proc newMaxIndependSetDp(ideal j, list #)
+"USAGE:   newMaxIndependentSetDp(I); I ideal (returns all maximal independent sets of the corresponding leading terms ideal)
+          newMaxIndependentSetDp(I, 0); I ideal (returns only one maximal independent set)
+RETURN:  list = #1. new varstring with the maximal independent set at the end,
+                #2. ordstring with the corresponding dp block ordering,
+                #3. the number of independent variables
+NOTE:
+EXAMPLE: example newMaxIndependentSetDp; shows an example
+"
+{
+  int n, k, di;
+  list resu, hilf;
+  string var1, var2;
+  list v = indepSet(j, 0);
+
+  // SL 2006.04.21 1 Lines modified to use only one independent Set
+  int allMaximal;
+  if (size(#) > 0)
+  {
+    allMaximal = #[1];
+  }
+  else
+  {
+    allMaximal = 1;
+  }
+
+  int nMax;
+  if (allMaximal == 1)
+  {
+    nMax = size(v);
+  }
+  else
+  {
+    nMax = 1;
+  }
+
+  for(n = 1; n <= nMax; n++)
+  // SL 2006.04.21 2
+  {
+    di = 0;
+    var1 = "";
+    var2 = "";
+    for(k = 1; k <= size(v[n]); k++)
+    {
+     if(v[n][k] != 0)
+      {
+        di++;
+        var2 = var2 + "var(" + string(k) + "), ";
+      }
+      else
+      {
+        var1 = var1 + "var(" + string(k) + "), ";
+      }
+    }
+    if(di > 0)
+    {
+      var1 = var1 + var2;
+      var1 = var1[1..size(var1) - 2];                         // The "- 2" removes the trailer comma
+      hilf[1] = var1;
+      // SL 2006.21.04 1 The order is now block dp instead of lp
+      hilf[2] = "dp(" + string(nvars(basering) - di) + "), dp(" + string(di) + ")";
+      // SL 2006.21.04 2
+      hilf[3] = di;
+      resu[n] = hilf;
+    }
+    else
+    {
+      resu[n] = varstr(basering), ordstr(basering), 0;
+    }
+  }
+  return(resu);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring s1 = (0, x, y), (a, b, c, d, e, f, g), lp;
+   ideal i = ea - fbg, fa + be, ec - fdg, fc + de;
+   i = std(i);
+   list l = newMaxIndependSetDp(i);
+   l;
+   i = i, g;
+   l = newMaxIndependSetDp(i);
+   l;
+
+   ring s = 0, (x, y, z), lp;
+   ideal i = z, yx;
+   list l = newMaxIndependSetDp(i);
+   l;
+}
+
+
+///////////////////////////////////////////////////////////////////////////////
+// based on prepareQuotientring
+// The order returned is now (C, dp) instead of (C, lp)
+
+static proc prepareQuotientRingDp (int nnp)
+"USAGE:   prepareQuotientRingDp(nnp); nnp int
+RETURN:  string = to define Kvar(nnp+1),...,var(nvars)[..rest ]
+NOTE:
+EXAMPLE: example prepareQuotientRingDp; shows an example
+"
+{
+  ideal @ih,@jh;
+  int npar=npars(basering);
+  int @n;
+
+  string quotring= "ring quring = ("+charstr(basering);
+  for(@n = nnp + 1; @n <= nvars(basering); @n++)
+  {
+     quotring = quotring + ", var(" + string(@n) + ")";
+     @ih = @ih + var(@n);
+  }
+
+  quotring = quotring+"),(var(1)";
+  @jh = @jh + var(1);
+  for(@n = 2; @n <= nnp; @n++)
+  {
+    quotring = quotring + ", var(" + string(@n) + ")";
+    @jh = @jh + var(@n);
+  }
+  // SL 2006-04-21 1 The order returned is now (C, dp) instead of (C, lp)
+  quotring = quotring + "), (C, dp);";
+  // SL 2006-04-21 2
+
+  return(quotring);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring s1=(0,x),(a,b,c,d,e,f,g),lp;
+   def @Q=basering;
+   list l= prepareQuotientRingDp(3);
+   l;
+   execute(l[1]);
+   execute(l[2]);
+   basering;
+   phi;
+   setring @Q;
+
+}
+
+///////////////////////////////////////////////////////////////////////////////
+proc prepareAss(ideal i)
+"USAGE:   prepareAss(I); I ideal
+RETURN:  list, the radicals of the maximal dimensional components of I.
+NOTE:    Uses algorithm of Eisenbud/Huneke/Vasconcelos.
+EXAMPLE: example prepareAss; shows an example
+"
+{
+  if(attrib(basering,"global")!=1)
+  {
+      ERROR(
+      "// Not implemented for this ordering, please change to global ordering."
+      );
+  }
+  ideal j=std(i);
+  int cod=nvars(basering)-dim(j);
+  int e;
+  list er;
+  ideal ann;
+  if(homog(i)==1)
+  {
+     list re=sres(j,0);                   //the resolution
+     re=minres(re);                       //minimized resolution
+  }
+  else
+  {
+    list re=mres(i,0);
+  }
+  for(e=cod;e<=nvars(basering);e++)
+  {
+     ann=AnnExt_R(e,re);
+
+     if(nvars(basering)-dim(std(ann))==e)
+     {
+        er[size(er)+1]=equiRadical(ann);
+     }
+  }
+  return(er);
+}
+example
+{ "EXAMPLE:";  echo = 2;
+   ring  r = 0,(x,y,z),dp;
+   poly  p = z2+1;
+   poly  q = z3+2;
+   ideal i = p*q^2,y-z2;
+   list pr = prepareAss(i);
+   pr;
+}
+///////////////////////////////////////////////////////////////////////////////
+proc equidimMaxEHV(ideal i)
+"USAGE:  equidimMaxEHV(I); I ideal
+RETURN:  ideal, the equidimensional component (of maximal dimension) of I.
+NOTE:    Uses algorithm of Eisenbud, Huneke and Vasconcelos.
+EXAMPLE: example equidimMaxEHV; shows an example
+"
+{
+  if(attrib(basering,"global")!=1)
+  {
+      ERROR(
+      "// Not implemented for this ordering, please change to global ordering."
+      );
+  }
+  ideal j=groebner(i);
+  int cod=nvars(basering)-dim(j);
+  int e;
+  ideal ann;
+  if(homog(i)==1)
+  {
+     list re=sres(j,0);                   //the resolution
+     re=minres(re);                       //minimized resolution
+  }
+  else
+  {
+    list re=mres(i,0);
+  }
+  ann=AnnExt_R(cod,re);
+  return(ann);
+}
+example
+{ "EXAMPLE:";  echo = 2;
+   ring  r = 0,(x,y,z),dp;
+   ideal i=intersect(ideal(z),ideal(x,y),ideal(x2,z2),ideal(x5,y5,z5));
+   equidimMaxEHV(i);
+}
+
+proc testPrimary(list pr, ideal k)
+"USAGE:   testPrimary(pr,k); pr a list, k an ideal.
+ASSUME:  pr is the result of primdecGTZ(k) or primdecSY(k).
+RETURN:  int, 1 if the intersection of the ideals in pr is k, 0 if not
+EXAMPLE: example testPrimary; shows an example
+"
+{
+   int i;
+   pr=reconvList(pr);
+   ideal j=pr[1];
+   for (i=2;i<=size(pr)/2;i++)
+   {
+       j=intersect(j,pr[2*i-1]);
+   }
+   return(idealsEqual(j,k));
+}
+example
+{ "EXAMPLE:";  echo = 2;
+   ring  r = 32003,(x,y,z),dp;
+   poly  p = z2+1;
+   poly  q = z4+2;
+   ideal i = p^2*q^3,(y-z3)^3,(x-yz+z4)^4;
+   list pr = primdecGTZ(i);
+   testPrimary(pr,i);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+proc zerodec(ideal I)
+"USAGE:   zerodec(I); I ideal
+ASSUME:  I is zero-dimensional, the characteristic of the ground field is 0
+RETURN:  list of primary ideals, the zero-dimensional decomposition of I
+NOTE:    The algorithm (of Monico), works well only for a small total number
+         of solutions (@code{vdim(std(I))} should be < 100) and without
+         parameters. In practice, it works also in large characteristic p>0
+         but may fail for small p.
+@*       If printlevel > 0 (default = 0) additional information is displayed.
+EXAMPLE: example zerodec; shows an example
+"
+{
+  if(attrib(basering,"global")!=1)
+  {
+    ERROR(
+    "// Not implemented for this ordering, please change to global ordering."
+    );
+  }
+  def R=basering;
+  poly q;
+  int j,time;
+  matrix m;
+  list re;
+  poly va=var(1);
+  ideal J=groebner(I);
+  ideal ba=kbase(J);
+  int d=vdim(J);
+  dbprint(printlevel-voice+2,"// multiplicity of ideal : "+ string(d));
+//------ compute matrix of multiplication on R/I with generic element p -----
+  int e=nvars(basering);
+  poly p=randomLast(100)[e]+random(-50,50);     //the generic element
+  matrix n[d][d];
+  time = timer;
+  for(j=2;j<=e;j++)
+  {
+    va=va*var(j);
+  }
+  for(j=1;j<=d;j++)
+  {
+    q=reduce(p*ba[j],J);
+    m=coeffs(q,ba,va);
+    n[j,1..d]=m[1..d,1];
+  }
+  dbprint(printlevel-voice+2,
+    "// time for computing multiplication matrix (with generic element) : "+
+    string(timer-time));
+//---------------- compute characteristic polynomial of matrix --------------
+  execute("ring P1=("+charstr(R)+"),T,dp;");
+  matrix n=imap(R,n);
+  time = timer;
+  poly charpol=det(n-T*freemodule(d));
+  dbprint(printlevel-voice+2,"// time for computing char poly: "+
+         string(timer-time));
+//------------------- factorize characteristic polynomial -------------------
+//check first if constant term of charpoly is != 0 (which is true for
+//sufficiently generic element)
+  if(charpol[size(charpol)]!=0)
+  {
+    time = timer;
+    list fac=factor(charpol);
+    testFactor(fac,charpol);
+    dbprint(printlevel-voice+2,"// time for factorizing char poly: "+
+            string(timer-time));
+    int f=size(fac[1]);
+//--------------------------- the irreducible case --------------------------
+    if(f==1)
+    {
+      setring R;
+      re=I;
+      return(re);
+    }
+//---------------------------- the reducible case ---------------------------
+//if f_i are the irreducible factors of charpoly, mult=ri, then <I,g_i^ri>
+//are the primary components where g_i = f_i(p). However, substituting p in
+//f_i may result in a huge object although the final result may be small.
+//Hence it is better to simultaneously reduce with I. For this we need a new
+//ring.
+    execute("ring P=("+charstr(R)+"),(T,"+varstr(R)+"),(dp(1),dp);");
+    list rfac=imap(P1,fac);
+    intvec ov=option(get);;
+    option(redSB);
+    list re1;
+    ideal new = T-imap(R,p),imap(R,J);
+    attrib(new, "isSB",1);    //we know that new is a standard basis
+    for(j=1;j<=f;j++)
+    {
+      re1[j]=reduce(rfac[1][j]^rfac[2][j],new);
+    }
+    setring R;
+    re = imap(P,re1);
+    for(j=1;j<=f;j++)
+    {
+      J=I,re[j];
+      re[j]=interred(J);
+    }
+    option(set,ov);
+    return(re);
+  }
+  else
+//------------------- choice of generic element failed -------------------
+  {
+    dbprint(printlevel-voice+2,"// try new generic element!");
+    setring R;
+    return(zerodec(I));
+  }
+}
+example
+{ "EXAMPLE:";  echo = 2;
+   ring r  = 0,(x,y),dp;
+   ideal i = x2-2,y2-2;
+   list pr = zerodec(i);
+   pr;
+}
+///////////////////////////////////////////////////////////////////////////////
+static proc newDecompStep(ideal i, list #)
+"USAGE:  newDecompStep(i); i ideal  (for primary decomposition)
+         newDecompStep(i,1);        (for the associated primes of dimension of i)
+         newDecompStep(i,2);        (for the minimal associated primes)
+         newDecompStep(i,3);        (for the absolute primary decomposition (not tested!))
+         "oneIndep";        (for using only one max indep set)
+         "intersect";        (returns alse the intersection of the components founded)
+
+RETURN:  list = list of primary ideals and their associated primes
+         (at even positions in the list)
+         (resp. a list of the minimal associated primes)
+NOTE:    Algorithm of Gianni/Trager/Zacharias
+EXAMPLE: example newDecompStep; shows an example
+"
+{
+  intvec op,@vv;
+  def  @P = basering;
+  list primary,indep,ltras;
+  intvec @vh,isat,@w;
+  int @wr,@k,@n,@m,@n1,@n2,@n3,homo,seri,keepdi,abspri,ab,nn;
+  ideal peek=i;
+  ideal ser,tras;
+  list data;
+  list result;
+  intvec @hilb;
+  int isS=(attrib(i,"isSB")==1);
+
+  // Debug
+  dbprint(printlevel - voice, "newDecompStep, v2.0");
+
+  string indepOption = "allIndep";
+  string intersectOption = "noIntersect";
+
+  if(size(#)>0)
+  {
+    int count = 1;
+    if(typeof(#[count]) == "string")
+    {
+      if ((#[count] == "oneIndep") or (#[count] == "allIndep"))
+      {
+        indepOption = #[count];
+        count++;
+      }
+    }
+    if(typeof(#[count]) == "string")
+    {
+      if ((#[count] == "intersect") or (#[count] == "noIntersect"))
+      {
+        intersectOption = #[count];
+        count++;
+      }
+    }
+    if((typeof(#[count]) == "int") or (typeof(#[count]) == "number"))
+    {
+      if ((#[count]==1)||(#[count]==2)||(#[count]==3))
+      {
+        @wr=#[count];
+        if(@wr==3){abspri = 1; @wr = 0;}
+        count++;
+      }
+    }
+    if(size(#)>count)
+    {
+      seri=1;
+      peek=#[count + 1];
+      ser=#[count + 2];
+    }
+  }
+  if(abspri)
+  {
+    list absprimary,abskeep,absprimarytmp,abskeeptmp;
+  }
+  homo=homog(i);
+  if(homo==1)
+  {
+    if(attrib(i,"isSB")!=1)
+    {
+      //ltras=mstd(i);
+      tras=groebner(i);
+      ltras=tras,tras;
+      attrib(ltras[1],"isSB",1);
+    }
+    else
+    {
+      ltras=i,i;
+      attrib(ltras[1],"isSB",1);
+    }
+    tras = ltras[1];
+    attrib(tras,"isSB",1);
+    if(dim(tras)==0)
+    {
+      primary[1]=ltras[2];
+      primary[2]=maxideal(1);
+      if(@wr>0)
+      {
+        list l;
+        l[2]=maxideal(1);
+        l[1]=maxideal(1);
+        if (intersectOption == "intersect")
+        {
+          return(list(l, maxideal(1)));
+        }
+        else
+        {
+          return(l);
+        }
+      }
+      if (intersectOption == "intersect")
+      {
+        return(list(primary, primary[1]));
+      }
+      else
+      {
+        return(primary);
+      }
+    }
+    for(@n=1;@n<=nvars(basering);@n++)
+    {
+      @w[@n]=ord(var(@n));
+    }
+    @hilb=hilb(tras,1,@w);
+    intvec keephilb=@hilb;
+  }
+
+  //----------------------------------------------------------------
+  //i is the zero-ideal
+  //----------------------------------------------------------------
+
+  if(size(i)==0)
+  {
+    primary=i,i;
+    if (intersectOption == "intersect")
+    {
+      return(list(primary, i));
+    }
+    else
+    {
+      return(primary);
+    }
+  }
+
+  //----------------------------------------------------------------
+  //pass to the lexicographical ordering and compute a standardbasis
+  //----------------------------------------------------------------
+
+  int lp=islp();
+
+  execute("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),(C,lp);");
+  op=option(get);
+  option(redSB);
+
+  ideal ser=fetch(@P,ser);
+  if(homo==1)
+  {
+    if(!lp)
+    {
+      ideal @j=std(fetch(@P,i),@hilb,@w);
+    }
+    else
+    {
+      ideal @j=fetch(@P,tras);
+      attrib(@j,"isSB",1);
+    }
+  }
+  else
+  {
+    if(lp&&isS)
+    {
+      ideal @j=fetch(@P,i);
+      attrib(@j,"isSB",1);
+    }
+    else
+    {
+      ideal @j=groebner(fetch(@P,i));
+    }
+  }
+  option(set,op);
+  if(seri==1)
+  {
+    ideal peek=fetch(@P,peek);
+    attrib(peek,"isSB",1);
+  }
+  else
+  {
+    ideal peek=@j;
+  }
+  if((size(ser)==0)&&(!abspri))
+  {
+    ideal fried;
+    @n=size(@j);
+    for(@k=1;@k<=@n;@k++)
+    {
+      if(deg(lead(@j[@k]))==1)
+      {
+        fried[size(fried)+1]=@j[@k];
+        @j[@k]=0;
+      }
+    }
+    if(size(fried)==nvars(basering))
+    {
+      setring @P;
+      primary[1]=i;
+      primary[2]=i;
+      if (intersectOption == "intersect")
+      {
+        return(list(primary, i));
+      }
+      else
+      {
+        return(primary);
+      }
+    }
+    if(size(fried)>0)
+    {
+      string newva;
+      string newma;
+      for(@k=1;@k<=nvars(basering);@k++)
+      {
+        @n1=0;
+        for(@n=1;@n<=size(fried);@n++)
+        {
+          if(leadmonom(fried[@n])==var(@k))
+          {
+            @n1=1;
+            break;
+          }
+        }
+        if(@n1==0)
+        {
+          newva=newva+string(var(@k))+",";
+          newma=newma+string(var(@k))+",";
+        }
+        else
+        {
+          newma=newma+string(0)+",";
+        }
+      }
+      newva[size(newva)]=")";
+      newma[size(newma)]=";";
+      execute("ring @deirf=("+charstr(gnir)+"),("+newva+",lp;");
+      execute("map @kappa=gnir,"+newma);
+      ideal @j= @kappa(@j);
+      @j=simplify(@j, 2);
+      attrib(@j,"isSB",1);
+      result = newDecompStep(@j, indepOption, intersectOption, @wr);
+      if (intersectOption == "intersect")
+      {
+       list pr = result[1];
+       ideal intersection = result[2];
+      }
+      else
+      {
+        list pr = result;
+      }
+
+      setring gnir;
+      list pr=imap(@deirf,pr);
+      for(@k=1;@k<=size(pr);@k++)
+      {
+        @j=pr[@k]+fried;
+        pr[@k]=@j;
+      }
+      if (intersectOption == "intersect")
+      {
+        ideal intersection = imap(@deirf, intersection);
+        @j = intersection + fried;
+        intersection = @j;
+      }
+      setring @P;
+      if (intersectOption == "intersect")
+      {
+        return(list(imap(gnir,pr), imap(gnir,intersection)));
+      }
+      else
+      {
+        return(imap(gnir,pr));
+      }
+    }
+  }
+  //----------------------------------------------------------------
+  //j is the ring
+  //----------------------------------------------------------------
+
+  if (dim(@j)==-1)
+  {
+    setring @P;
+    primary=ideal(1),ideal(1);
+    if (intersectOption == "intersect")
+    {
+      return(list(primary, ideal(1)));
+    }
+    else
+    {
+      return(primary);
+    }
+  }
+
+  //----------------------------------------------------------------
+  //  the case of one variable
+  //----------------------------------------------------------------
+
+  if(nvars(basering)==1)
+  {
+    list fac=factor(@j[1]);
+    list gprimary;
+    poly generator;
+    ideal gIntersection;
+    for(@k=1;@k<=size(fac[1]);@k++)
+    {
+      if(@wr==0)
+      {
+        gprimary[2*@k-1]=ideal(fac[1][@k]^fac[2][@k]);
+        gprimary[2*@k]=ideal(fac[1][@k]);
+      }
+      else
+      {
+        gprimary[2*@k-1]=ideal(fac[1][@k]);
+        gprimary[2*@k]=ideal(fac[1][@k]);
+      }
+      if (intersectOption == "intersect")
+      {
+        generator = generator * fac[1][@k];
+      }
+    }
+    if (intersectOption == "intersect")
+    {
+      gIntersection = generator;
+    }
+    setring @P;
+    primary=fetch(gnir,gprimary);
+    if (intersectOption == "intersect")
+    {
+      ideal intersection = fetch(gnir,gIntersection);
+    }
+
+//HIER
+    if(abspri)
+    {
+      list resu,tempo;
+      string absotto;
+      for(ab=1;ab<=size(primary)/2;ab++)
+      {
+        absotto= absFactorize(primary[2*ab][1],77);
+        tempo=primary[2*ab-1],primary[2*ab],absotto,string(var(nvars(basering)));
+        resu[ab]=tempo;
+      }
+      primary=resu;
+      intersection = 1;
+      for(ab=1;ab<=size(primary);ab++)
+      {
+        intersection = intersect(intersection, primary[ab][2]);
+      }
+    }
+    if (intersectOption == "intersect")
+    {
+      return(list(primary, intersection));
+    }
+    else
+    {
+      return(primary);
+    }
+  }
+
+ //------------------------------------------------------------------
+ //the zero-dimensional case
+ //------------------------------------------------------------------
+  if (dim(@j)==0)
+  {
+    op=option(get);
+    option(redSB);
+    list gprimary= newZero_decomp(@j,ser,@wr);
+
+    setring @P;
+    primary=fetch(gnir,gprimary);
+
+    if(size(ser)>0)
+    {
+      primary=cleanPrimary(primary);
+    }
+//HIER
+    if(abspri)
+    {
+      list resu,tempo;
+      string absotto;
+      for(ab=1;ab<=size(primary)/2;ab++)
+      {
+        absotto= absFactorize(primary[2*ab][1],77);
+        tempo=primary[2*ab-1],primary[2*ab],absotto,string(var(nvars(basering)));
+        resu[ab]=tempo;
+      }
+      primary=resu;
+    }
+    if (intersectOption == "intersect")
+    {
+      return(list(primary, fetch(gnir,@j)));
+    }
+    else
+    {
+      return(primary);
+    }
+  }
+
+  poly @gs,@gh,@p;
+  string @va,quotring;
+  list quprimary,htprimary,collectprimary,lsau,lnew,allindep,restindep;
+  ideal @h;
+  int jdim=dim(@j);
+  list fett;
+  int lauf,di,newtest;
+  //------------------------------------------------------------------
+  //search for a maximal independent set indep,i.e.
+  //look for subring such that the intersection with the ideal is zero
+  //j intersected with K[var(indep[3]+1),...,var(nvar] is zero,
+  //indep[1] is the new varstring and indep[2] the string for block-ordering
+  //------------------------------------------------------------------
+  if(@wr!=1)
+  {
+    allindep = newMaxIndependSetLp(@j, indepOption);
+    for(@m=1;@m<=size(allindep);@m++)
+    {
+      if(allindep[@m][3]==jdim)
+      {
+        di++;
+        indep[di]=allindep[@m];
+      }
+      else
+      {
+        lauf++;
+        restindep[lauf]=allindep[@m];
+      }
+    }
+  }
+  else
+  {
+    indep = newMaxIndependSetLp(@j, indepOption);
+  }
+
+  ideal jkeep=@j;
+  if(ordstr(@P)[1]=="w")
+  {
+    execute("ring @Phelp=("+charstr(gnir)+"),("+varstr(gnir)+"),("+ordstr(@P)+");");
+  }
+  else
+  {
+    execute( "ring @Phelp=("+charstr(gnir)+"),("+varstr(gnir)+"),(C,dp);");
+  }
+
+  if(homo==1)
+  {
+    if((ordstr(@P)[3]=="d")||(ordstr(@P)[1]=="d")||(ordstr(@P)[1]=="w")
+       ||(ordstr(@P)[3]=="w"))
+    {
+      ideal jwork=imap(@P,tras);
+      attrib(jwork,"isSB",1);
+    }
+    else
+    {
+      ideal jwork=std(imap(gnir,@j),@hilb,@w);
+    }
+  }
+  else
+  {
+    ideal jwork=groebner(imap(gnir,@j));
+  }
+  list hquprimary;
+  poly @p,@q;
+  ideal @h,fac,ser;
+//Aenderung================
+  ideal @Ptest=1;
+//=========================
+  di=dim(jwork);
+  keepdi=di;
+
+  ser = 1;
+
+  setring gnir;
+  for(@m=1; @m<=size(indep); @m++)
+  {
+    data[1] = indep[@m];
+    result = newReduction(@j, ser, @hilb, @w, jdim, abspri, @wr, data);
+    quprimary = quprimary + result[1];
+    if(abspri)
+    {
+      absprimary = absprimary + result[2];
+      abskeep = abskeep + result[3];
+    }
+    @h = result[5];
+    ser = result[4];
+    if(size(@h)>0)
+    {
+      //---------------------------------------------------------------
+      //we change to @Phelp to have the ordering dp for saturation
+      //---------------------------------------------------------------
+
+      setring @Phelp;
+      @h=imap(gnir,@h);
+//Aenderung==================================
+      if(defined(@LL)){kill @LL;}
+      list @LL=minSat(jwork,@h);
+      @Ptest=intersect(@Ptest,@LL[1]);
+      ser = intersect(ser, @LL[1]);
+//===========================================
+
+      if(@wr!=1)
+      {
+//Aenderung==================================
+        @q=@LL[2];
+//===========================================
+        //@q=minSat(jwork,@h)[2];
+      }
+      else
+      {
+        fac=ideal(0);
+        for(lauf=1;lauf<=ncols(@h);lauf++)
+        {
+          if(deg(@h[lauf])>0)
+          {
+            fac=fac+factorize(@h[lauf],1);
+          }
+        }
+        fac=simplify(fac,6);
+        @q=1;
+        for(lauf=1;lauf<=size(fac);lauf++)
+        {
+          @q=@q*fac[lauf];
+        }
+      }
+      jwork = std(jwork,@q);
+      keepdi = dim(jwork);
+      if(keepdi < di)
+      {
+        setring gnir;
+        @j = imap(@Phelp, jwork);
+        ser = imap(@Phelp, ser);
+        break;
+      }
+      if(homo == 1)
+      {
+        @hilb = hilb(jwork, 1, @w);
+      }
+
+      setring gnir;
+      ser = imap(@Phelp, ser);
+      @j = imap(@Phelp, jwork);
+    }
+  }
+
+  if((size(quprimary)==0)&&(@wr==1))
+  {
+     @j=ideal(1);
+     quprimary[1]=ideal(1);
+     quprimary[2]=ideal(1);
+  }
+  if((size(quprimary)==0))
+  {
+    keepdi = di - 1;
+    quprimary[1]=ideal(1);
+    quprimary[2]=ideal(1);
+  }
+  //---------------------------------------------------------------
+  //notice that j=sat(j,gh) intersected with (j,gh^n)
+  //we finished with sat(j,gh) and have to start with (j,gh^n)
+  //---------------------------------------------------------------
+  if((deg(@j[1])!=0)&&(@wr!=1))
+  {
+     if(size(quprimary)>0)
+     {
+        setring @Phelp;
+        ser=imap(gnir,ser);
+
+        hquprimary=imap(gnir,quprimary);
+        if(@wr==0)
+        {
+//Aenderung====================================================
+//HIER STATT DURCHSCHNITT SATURIEREN!
+           ideal htest=@Ptest;
+/*
+           ideal htest=hquprimary[1];
+           for (@n1=2;@n1<=size(hquprimary)/2;@n1++)
+           {
+              htest=intersect(htest,hquprimary[2*@n1-1]);
+           }
+*/
+//=============================================================
+        }
+        else
+        {
+           ideal htest=hquprimary[2];
+
+           for (@n1=2;@n1<=size(hquprimary)/2;@n1++)
+           {
+              htest=intersect(htest,hquprimary[2*@n1]);
+           }
+        }
+
+        if(size(ser)>0)
+        {
+           ser=intersect(htest,ser);
+        }
+        else
+        {
+          ser=htest;
+        }
+        setring gnir;
+        ser=imap(@Phelp,ser);
+     }
+     if(size(reduce(ser,peek,1))!=0)
+     {
+        for(@m=1;@m<=size(restindep);@m++)
+        {
+         // if(restindep[@m][3]>=keepdi)
+         // {
+           isat=0;
+           @n2=0;
+
+           if(restindep[@m][1]==varstr(basering))
+           //the good case, nothing to do, just to have the same notations
+           //change the ring
+           {
+              execute("ring gnir1 = ("+charstr(basering)+"),("+
+                varstr(basering)+"),("+ordstr(basering)+");");
+              ideal @j=fetch(gnir,jkeep);
+              attrib(@j,"isSB",1);
+           }
+           else
+           {
+              @va=string(maxideal(1));
+              execute("ring gnir1 = ("+charstr(basering)+"),("+
+                      restindep[@m][1]+"),(" +restindep[@m][2]+");");
+              execute("map phi=gnir,"+@va+";");
+              op=option(get);
+              option(redSB);
+              if(homo==1)
+              {
+                 ideal @j=std(phi(jkeep),keephilb,@w);
+              }
+              else
+              {
+                ideal @j=groebner(phi(jkeep));
+              }
+              ideal ser=phi(ser);
+              option(set,op);
+           }
+
+           for (lauf=1;lauf<=size(@j);lauf++)
+           {
+              fett[lauf]=size(@j[lauf]);
+           }
+           //------------------------------------------------------------------
+           //we have now the following situation:
+           //j intersected with K[var(nnp+1),..,var(nva)] is zero so we may
+           //pass to this quotientring, j is their still a standardbasis, the
+           //leading coefficients of the polynomials  there (polynomials in
+           //K[var(nnp+1),..,var(nva)]) are collected in the list h,
+           //we need their ggt, gh, because of the following:
+           //let (j:gh^n)=(j:gh^infinity) then
+           //j*K(var(nnp+1),..,var(nva))[..the rest..]
+           //intersected with K[var(1),...,var(nva)] is (j:gh^n)
+           //on the other hand j=(j,gh^n) intersected with (j:gh^n)
+
+           //------------------------------------------------------------------
+
+           //the arrangement for the quotientring
+           // K(var(nnp+1),..,var(nva))[..the rest..]
+           //and the map phi:K[var(1),...,var(nva)] ---->
+           //--->K(var(nnpr+1),..,var(nva))[..the rest..]
+           //------------------------------------------------------------------
+
+           quotring=prepareQuotientring(nvars(basering)-restindep[@m][3]);
+
+           //------------------------------------------------------------------
+           //we pass to the quotientring  K(var(nnp+1),..,var(nva))[..rest..]
+           //------------------------------------------------------------------
+
+           execute(quotring);
+
+           // @j considered in the quotientring
+           ideal @j=imap(gnir1,@j);
+           ideal ser=imap(gnir1,ser);
+
+           kill gnir1;
+
+           //j is a standardbasis in the quotientring but usually not minimal
+           //here it becomes minimal
+           @j=clearSB(@j,fett);
+           attrib(@j,"isSB",1);
+
+           //we need later ggt(h[1],...)=gh for saturation
+           ideal @h;
+
+           for(@n=1;@n<=size(@j);@n++)
+           {
+              @h[@n]=leadcoef(@j[@n]);
+           }
+           //the primary decomposition of j*K(var(nnp+1),..,var(nva))[..rest..]
+
+           op=option(get);
+           option(redSB);
+           list uprimary= newZero_decomp(@j,ser,@wr);
+//HIER
+           if(abspri)
+           {
+              ideal II;
+              ideal jmap;
+              map sigma;
+              nn=nvars(basering);
+              map invsigma=basering,maxideal(1);
+              for(ab=1;ab<=size(uprimary)/2;ab++)
+              {
+                 II=uprimary[2*ab];
+                 attrib(II,"isSB",1);
+                 if(deg(II[1])!=vdim(II))
+                 {
+                    jmap=randomLast(50);
+                    sigma=basering,jmap;
+                    jmap[nn]=2*var(nn)-jmap[nn];
+                    invsigma=basering,jmap;
+                    II=groebner(sigma(II));
+                  }
+                  absprimarytmp[ab]= absFactorize(II[1],77);
+                  II=var(nn);
+                  abskeeptmp[ab]=string(invsigma(II));
+                  invsigma=basering,maxideal(1);
+              }
+           }
+           option(set,op);
+
+           //we need the intersection of the ideals in the list quprimary with
+           //the polynomialring, i.e. let q=(f1,...,fr) in the quotientring
+           //such an ideal but fi polynomials, then the intersection of q with
+           //the polynomialring is the saturation of the ideal generated by
+           //f1,...,fr with respect toh which is the lcm of the leading
+           //coefficients of the fi considered in the quotientring:
+           //this is coded in saturn
+
+           list saturn;
+           ideal hpl;
+
+           for(@n=1;@n<=size(uprimary);@n++)
+           {
+              hpl=0;
+              for(@n1=1;@n1<=size(uprimary[@n]);@n1++)
+              {
+                 hpl=hpl,leadcoef(uprimary[@n][@n1]);
+              }
+              saturn[@n]=hpl;
+           }
+           //------------------------------------------------------------------
+           //we leave  the quotientring   K(var(nnp+1),..,var(nva))[..rest..]
+           //back to the polynomialring
+           //------------------------------------------------------------------
+           setring gnir;
+           collectprimary=imap(quring,uprimary);
+           lsau=imap(quring,saturn);
+           @h=imap(quring,@h);
+
+           kill quring;
+
+
+           @n2=size(quprimary);
+//================NEU=========================================
+           if(deg(quprimary[1][1])<=0){ @n2=0; }
+//============================================================
+
+           @n3=@n2;
+
+           for(@n1=1;@n1<=size(collectprimary)/2;@n1++)
+           {
+              if(deg(collectprimary[2*@n1][1])>0)
+              {
+                 @n2++;
+                 quprimary[@n2]=collectprimary[2*@n1-1];
+                 lnew[@n2]=lsau[2*@n1-1];
+                 @n2++;
+                 lnew[@n2]=lsau[2*@n1];
+                 quprimary[@n2]=collectprimary[2*@n1];
+                 if(abspri)
+                 {
+                   absprimary[@n2/2]=absprimarytmp[@n1];
+                   abskeep[@n2/2]=abskeeptmp[@n1];
+                 }
+              }
+           }
+
+
+           //here the intersection with the polynomialring
+           //mentioned above is really computed
+
+           for(@n=@n3/2+1;@n<=@n2/2;@n++)
+           {
+              if(specialIdealsEqual(quprimary[2*@n-1],quprimary[2*@n]))
+              {
+                 quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
+                 quprimary[2*@n]=quprimary[2*@n-1];
+              }
+              else
+              {
+                 if(@wr==0)
+                 {
+                    quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
+                 }
+                 quprimary[2*@n]=sat2(quprimary[2*@n],lnew[2*@n])[1];
+              }
+           }
+           if(@n2>=@n3+2)
+           {
+              setring @Phelp;
+              ser=imap(gnir,ser);
+              hquprimary=imap(gnir,quprimary);
+              for(@n=@n3/2+1;@n<=@n2/2;@n++)
+              {
+                if(@wr==0)
+                {
+                   ser=intersect(ser,hquprimary[2*@n-1]);
+                }
+                else
+                {
+                   ser=intersect(ser,hquprimary[2*@n]);
+                }
+              }
+              setring gnir;
+              ser=imap(@Phelp,ser);
+           }
+
+         // }
+        }
+//HIER
+        if(abspri)
+        {
+          list resu,tempo;
+          for(ab=1;ab<=size(quprimary)/2;ab++)
+          {
+             if (deg(quprimary[2*ab][1])!=0)
+             {
+               tempo=quprimary[2*ab-1],quprimary[2*ab],
+                         absprimary[ab],abskeep[ab];
+               resu[ab]=tempo;
+             }
+          }
+          quprimary=resu;
+          @wr=3;
+        }
+        if(size(reduce(ser,peek,1))!=0)
+        {
+           if(@wr>0)
+           {
+              // The following line was dropped to avoid the recursion step:
+              //htprimary=newDecompStep(@j,@wr,peek,ser);
+              htprimary = list();
+           }
+           else
+           {
+              // The following line was dropped to avoid the recursion step:
+              //htprimary=newDecompStep(@j,peek,ser);
+              htprimary = list();
+           }
+           // here we collect now both results primary(sat(j,gh))
+           // and primary(j,gh^n)
+           @n=size(quprimary);
+           if (deg(quprimary[1][1])<=0) { @n=0; }
+           for (@k=1;@k<=size(htprimary);@k++)
+           {
+              quprimary[@n+@k]=htprimary[@k];
+           }
+        }
+     }
+   }
+   else
+   {
+      if(abspri)
+      {
+        list resu,tempo;
+        for(ab=1;ab<=size(quprimary)/2;ab++)
+        {
+           tempo=quprimary[2*ab-1],quprimary[2*ab],
+                   absprimary[ab],abskeep[ab];
+           resu[ab]=tempo;
+        }
+        quprimary=resu;
+      }
+   }
+  //---------------------------------------------------------------------------
+  //back to the ring we started with
+  //the final result: primary
+  //---------------------------------------------------------------------------
+
+  setring @P;
+  primary=imap(gnir,quprimary);
+
+  if (intersectOption == "intersect")
+  {
+     return(list(primary, imap(gnir, ser)));
+  }
+  else
+  {
+    return(primary);
+  }
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring  r = 32003,(x,y,z),lp;
+   poly  p = z2+1;
+   poly  q = z4+2;
+   ideal i = p^2*q^3,(y-z3)^3,(x-yz+z4)^4;
+   list pr= newDecompStep(i);
+   pr;
+   testPrimary( pr, i);
+}
+
+// This was part of proc decomp.
+// In proc newDecompStep, used for the computation of the minimal associated primes,
+// this part was separated as a soubrutine to make the code more clear.
+// Also, since the reduction is performed twice in proc newDecompStep, it should use both times this routine.
+// This is not yet implemented, since the reduction is not exactly the same and some changes should be made.
+static proc newReduction(ideal @j, ideal ser, intvec @hilb, intvec @w, int jdim, int abspri, int @wr, list data)
+{
+   string @va;
+   string quotring;
+   intvec op;
+   intvec @vv;
+   def gnir = basering;
+   ideal isat=0;
+   int @n;
+   int @n1 = 0;
+   int @n2 = 0;
+   int @n3 = 0;
+   int homo = homog(@j);
+   int lauf;
+   int @k;
+   list fett;
+   int keepdi;
+   list collectprimary;
+   list lsau;
+   list lnew;
+   ideal @h;
+
+   list indepInfo = data[1];
+   list quprimary = list();
+
+   //if(abspri)
+   //{
+     int ab;
+     list absprimarytmp,abskeeptmp;
+     list absprimary, abskeep;
+   //}
+   // Debug
+   dbprint(printlevel - voice, "newReduction, v2.0");
+
+   if((indepInfo[1]==varstr(basering)))  // &&(@m==1)
+   //this is the good case, nothing to do, just to have the same notations
+   //change the ring
+   {
+     execute("ring gnir1 = ("+charstr(basering)+"),("+varstr(basering)+"),("
+                              +ordstr(basering)+");");
+     ideal @j = fetch(gnir, @j);
+     attrib(@j,"isSB",1);
+     ideal ser = fetch(gnir, ser);
+   }
+   else
+   {
+     @va=string(maxideal(1));
+//Aenderung==============
+     //if(@m==1)
+     //{
+     //  @j=fetch(@P,i);
+     //}
+//=======================
+     execute("ring gnir1 = ("+charstr(basering)+"),("+indepInfo[1]+"),("
+                              +indepInfo[2]+");");
+     execute("map phi=gnir,"+@va+";");
+     op=option(get);
+     option(redSB);
+     if(homo==1)
+     {
+       ideal @j=std(phi(@j),@hilb,@w);
+     }
+     else
+     {
+       ideal @j=groebner(phi(@j));
+     }
+     ideal ser=phi(ser);
+
+     option(set,op);
+   }
+   if((deg(@j[1])==0)||(dim(@j)<jdim))
+   {
+     setring gnir;
+     break;
+   }
+   for (lauf=1;lauf<=size(@j);lauf++)
+   {
+     fett[lauf]=size(@j[lauf]);
+   }
+   //------------------------------------------------------------------------
+   //we have now the following situation:
+   //j intersected with K[var(nnp+1),..,var(nva)] is zero so we may pass
+   //to this quotientring, j is their still a standardbasis, the
+   //leading coefficients of the polynomials  there (polynomials in
+   //K[var(nnp+1),..,var(nva)]) are collected in the list h,
+   //we need their ggt, gh, because of the following: let
+   //(j:gh^n)=(j:gh^infinity) then j*K(var(nnp+1),..,var(nva))[..the rest..]
+   //intersected with K[var(1),...,var(nva)] is (j:gh^n)
+   //on the other hand j=(j,gh^n) intersected with (j:gh^n)
+
+   //------------------------------------------------------------------------
+
+   //arrangement for quotientring K(var(nnp+1),..,var(nva))[..the rest..] and
+   //map phi:K[var(1),...,var(nva)] --->K(var(nnpr+1),..,var(nva))[..rest..]
+   //------------------------------------------------------------------------
+
+   quotring=prepareQuotientring(nvars(basering)-indepInfo[3]);
+
+   //---------------------------------------------------------------------
+   //we pass to the quotientring   K(var(nnp+1),..,var(nva))[..the rest..]
+   //---------------------------------------------------------------------
+
+   ideal @jj=lead(@j);               //!! vorn vereinbaren
+   execute(quotring);
+
+   ideal @jj=imap(gnir1,@jj);
+   @vv=clearSBNeu(@jj,fett);  //!! vorn vereinbaren
+   setring gnir1;
+   @k=size(@j);
+   for (lauf=1;lauf<=@k;lauf++)
+   {
+     if(@vv[lauf]==1)
+     {
+       @j[lauf]=0;
+     }
+   }
+   @j=simplify(@j,2);
+   setring quring;
+   // @j considered in the quotientring
+   ideal @j=imap(gnir1,@j);
+
+   ideal ser=imap(gnir1,ser);
+
+   kill gnir1;
+
+   //j is a standardbasis in the quotientring but usually not minimal
+   //here it becomes minimal
+
+   attrib(@j,"isSB",1);
+
+   //we need later ggt(h[1],...)=gh for saturation
+   ideal @h;
+   if(deg(@j[1])>0)
+   {
+     for(@n=1;@n<=size(@j);@n++)
+     {
+       @h[@n]=leadcoef(@j[@n]);
+     }
+     //the primary decomposition of j*K(var(nnp+1),..,var(nva))[..the rest..]
+     op=option(get);
+     option(redSB);
+
+     int zeroMinAss = @wr;
+     if (@wr == 2) {zeroMinAss = 1;}
+     list uprimary= newZero_decomp(@j, ser, zeroMinAss);
+
+//HIER
+     if(abspri)
+     {
+       ideal II;
+       ideal jmap;
+       map sigma;
+       nn=nvars(basering);
+       map invsigma=basering,maxideal(1);
+       for(ab=1;ab<=size(uprimary)/2;ab++)
+       {
+         II=uprimary[2*ab];
+         attrib(II,"isSB",1);
+         if(deg(II[1])!=vdim(II))
+         {
+           jmap=randomLast(50);
+           sigma=basering,jmap;
+           jmap[nn]=2*var(nn)-jmap[nn];
+           invsigma=basering,jmap;
+           II=groebner(sigma(II));
+         }
+         absprimarytmp[ab]= absFactorize(II[1],77);
+         II=var(nn);
+         abskeeptmp[ab]=string(invsigma(II));
+         invsigma=basering,maxideal(1);
+       }
+     }
+     option(set,op);
+   }
+   else
+   {
+     list uprimary;
+     uprimary[1]=ideal(1);
+     uprimary[2]=ideal(1);
+   }
+   //we need the intersection of the ideals in the list quprimary with the
+   //polynomialring, i.e. let q=(f1,...,fr) in the quotientring such an ideal
+   //but fi polynomials, then the intersection of q with the polynomialring
+   //is the saturation of the ideal generated by f1,...,fr with respect to
+   //h which is the lcm of the leading coefficients of the fi considered in
+   //in the quotientring: this is coded in saturn
+
+   list saturn;
+   ideal hpl;
+
+   for(@n=1;@n<=size(uprimary);@n++)
+   {
+     uprimary[@n]=interred(uprimary[@n]); // temporary fix
+     hpl=0;
+     for(@n1=1;@n1<=size(uprimary[@n]);@n1++)
+     {
+       hpl=hpl,leadcoef(uprimary[@n][@n1]);
+     }
+     saturn[@n]=hpl;
+   }
+
+   //--------------------------------------------------------------------
+   //we leave  the quotientring   K(var(nnp+1),..,var(nva))[..the rest..]
+   //back to the polynomialring
+   //---------------------------------------------------------------------
+   setring gnir;
+
+   collectprimary=imap(quring,uprimary);
+   lsau=imap(quring,saturn);
+   @h=imap(quring,@h);
+
+   kill quring;
+
+   @n2=size(quprimary);
+   @n3=@n2;
+
+   for(@n1=1;@n1<=size(collectprimary)/2;@n1++)
+   {
+     if(deg(collectprimary[2*@n1][1])>0)
+     {
+       @n2++;
+       quprimary[@n2]=collectprimary[2*@n1-1];
+       lnew[@n2]=lsau[2*@n1-1];
+       @n2++;
+       lnew[@n2]=lsau[2*@n1];
+       quprimary[@n2]=collectprimary[2*@n1];
+       if(abspri)
+       {
+         absprimary[@n2/2]=absprimarytmp[@n1];
+         abskeep[@n2/2]=abskeeptmp[@n1];
+       }
+     }
+   }
+
+   //here the intersection with the polynomialring
+   //mentioned above is really computed
+   for(@n=@n3/2+1;@n<=@n2/2;@n++)
+   {
+     if(specialIdealsEqual(quprimary[2*@n-1],quprimary[2*@n]))
+     {
+       quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
+       quprimary[2*@n]=quprimary[2*@n-1];
+     }
+     else
+     {
+       if(@wr==0)
+       {
+         quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
+       }
+       quprimary[2*@n]=sat2(quprimary[2*@n],lnew[2*@n])[1];
+     }
+   }
+
+   return(quprimary, absprimary, abskeep, ser, @h);
+}
+
+
+////////////////////////////////////////////////////////////////////////////
+
+
+
+
+///////////////////////////////////////////////////////////////////////////////
+// Based on minAssGTZ
+
+proc minAss(ideal i,list #)
+"USAGE:   minAss(I[, l]); i ideal, l list (optional) of parameters, same as minAssGTZ
+RETURN:  a list, the minimal associated prime ideals of I.
+NOTE:    Designed for characteristic 0, works also in char k > 0 based
+         on an algorithm of Yokoyama
+EXAMPLE: example minAss; shows an example
+"
+{
+  return(minAssGTZ(i,#));
+}
+example
+{ "EXAMPLE:";  echo = 2;
+   ring  r = 0, (x, y, z), dp;
+   poly  p = z2 + 1;
+   poly  q = z3 + 2;
+   ideal i = p * q^2, y - z2;
+   list pr = minAss(i);
+   pr;
+}
+
+
+///////////////////////////////////////////////////////////////////////////////
+//
+// Computes the minimal associated primes of I via Laplagne algorithm,
+// using primary decomposition in the zero dimensional case.
+// For reduction to the zerodimensional case, it uses the procedure
+// decomp, with some modifications to avoid the recursion.
+//
+
+static proc minAssSL(ideal I)
+// Input = I, ideal
+// Output = primaryDec where primaryDec is the list of the minimal
+// associated primes and the primary components corresponding to these primes.
+{
+  ideal P = 1;
+  list pd = list();
+  int k;
+  int stop = 0;
+  list primaryDec = list();
+
+  while (stop == 0)
+  {
+    // Debug
+    dbprint(printlevel - voice, "// We call minAssSLIteration to find new prime ideals!");
+    pd = minAssSLIteration(I, P);
+    // Debug
+    dbprint(printlevel - voice, "// Output of minAssSLIteration:");
+    dbprint(printlevel - voice, pd);
+    if (size(pd[1]) > 0)
+    {
+      primaryDec = primaryDec + pd[1];
+      // Debug
+      dbprint(printlevel - voice, "// We intersect the prime ideals obtained.");
+      P = intersect(P, pd[2]);
+      // Debug
+      dbprint(printlevel - voice, "// Intersection finished.");
+    }
+    else
+    {
+      stop = 1;
+    }
+  }
+
+  // Returns only the primary components, not the radical.
+  return(primaryDec);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+// Given an ideal I and an ideal P (intersection of some minimal prime ideals
+// associated to I), it calculates new minimal prime ideals associated to I
+// which were not used to calculate P.
+// This version uses Primary Decomposition in the zerodimensional case.
+static proc minAssSLIteration(ideal I, ideal P);
+{
+  int k = 1;
+  int good  = 0;
+  list primaryDec = list();
+  // Debug
+  dbprint (printlevel-voice, "// We search for an element in P - sqrt(I).");
+  while ((k <= size(P)) and (good == 0))
+  {
+    good = 1 - rad_con(P[k], I);
+    k++;
+  }
+  k--;
+  if (good == 0)
+  {
+    // Debug
+    dbprint (printlevel - voice, "// No element was found, P = sqrt(I).");
+    return (list(primaryDec, ideal(0)));
+  }
+  // Debug
+  dbprint (printlevel - voice, "// We found h = ", P[k]);
+  dbprint (printlevel - voice, "// We calculate the saturation of I with respect to the element just founded.");
+  ideal J = sat(I, P[k])[1];
+
+  // Uses decomp from primdec, modified to avoid the recursion.
+  // Debug
+  dbprint(printlevel - voice, "// We do the reduction to the zerodimensional case, via decomp.");
+
+  primaryDec = newDecompStep(J, "oneIndep", "intersect", 2);
+  // Debug
+  dbprint(printlevel - voice, "// Proc decomp has found", size(primaryDec) / 2, "new primary components.");
+
+  return(primaryDec);
+}
+
+
+
+///////////////////////////////////////////////////////////////////////////////////
+// Based on maxIndependSet
+// Added list # as parameter
+// If the first element of # is 0, the output is only 1 max indep set.
+// If no list is specified or #[1] = 1, the output is all the max indep set of the
+// leading terms ideal. This is the original output of maxIndependSet
+
+proc newMaxIndependSetLp(ideal j, list #)
+"USAGE:   newMaxIndependentSetLp(i); i ideal (returns all maximal independent sets of the corresponding leading terms ideal)
+          newMaxIndependentSetLp(i, 0); i ideal (returns only one maximal independent set)
+RETURN:  list = #1. new varstring with the maximal independent set at the end,
+                #2. ordstring with the lp ordering,
+                #3. the number of independent variables
+NOTE:
+EXAMPLE: example newMaxIndependentSetLp; shows an example
+"
+{
+  int n, k, di;
+  list resu, hilf;
+  string var1, var2;
+  list v = indepSet(j, 0);
+
+  // SL 2006.04.21 1 Lines modified to use only one independent Set
+  string indepOption;
+  if (size(#) > 0)
+  {
+    indepOption = #[1];
+  }
+  else
+  {
+    indepOption = "allIndep";
+  }
+
+  int nMax;
+  if (indepOption == "allIndep")
+  {
+    nMax = size(v);
+  }
+  else
+  {
+    nMax = 1;
+  }
+
+  for(n = 1; n <= nMax; n++)
+  // SL 2006.04.21 2
+  {
+    di = 0;
+    var1 = "";
+    var2 = "";
+    for(k = 1; k <= size(v[n]); k++)
+    {
+      if(v[n][k] != 0)
+      {
+        di++;
+        var2 = var2 + "var(" + string(k) + "), ";
+      }
+      else
+      {
+        var1 = var1 + "var(" + string(k) + "), ";
+      }
+    }
+    if(di > 0)
+    {
+      var1 = var1 + var2;
+      var1 = var1[1..size(var1) - 2];       // The "- 2" removes the trailer comma
+      hilf[1] = var1;
+      // SL 2006.21.04 1 The order is now block dp instead of lp
+      //hilf[2] = "dp(" + string(nvars(basering) - di) + "), dp(" + string(di) + ")";
+      // SL 2006.21.04 2
+      // For decomp, lp ordering is needed. Nothing is changed.
+      hilf[2] = "lp";
+      hilf[3] = di;
+      resu[n] = hilf;
+    }
+    else
+    {
+      resu[n] = varstr(basering), ordstr(basering), 0;
+    }
+  }
+  return(resu);
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   ring s1 = (0, x, y), (a, b, c, d, e, f, g), lp;
+   ideal i = ea - fbg, fa + be, ec - fdg, fc + de;
+   i = std(i);
+   list l = newMaxIndependSetLp(i);
+   l;
+   i = i, g;
+   l = newMaxIndependSetLp(i);
+   l;
+
+   ring s = 0, (x, y, z), lp;
+   ideal i = z, yx;
+   list l = newMaxIndependSetLp(i);
+   l;
+}
+
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc newZero_decomp (ideal j, ideal ser, int @wr, list #)
+"USAGE:   newZero_decomp(j,ser,@wr); j,ser ideals, @wr=0 or 1
+         (@wr=0 for primary decomposition, @wr=1 for computation of associated
+         primes)
+         if #[1] = "nest", then #[2] indicates the nest level (number of recursive calls)
+         When the nest level is high it indicates that the computation is difficult,
+         and different methods are applied.
+RETURN:  list = list of primary ideals and their radicals (at even positions
+         in the list) if the input is zero-dimensional and a standardbases
+         with respect to lex-ordering
+         If ser!=(0) and ser is contained in j or if j is not zero-dimen-
+         sional then ideal(1),ideal(1) is returned
+NOTE:    Algorithm of Gianni/Trager/Zacharias
+EXAMPLE: example newZero_decomp; shows an example
+"
+{
+  def   @P = basering;
+  int uytrewq;
+  int nva = nvars(basering);
+  int @k,@s,@n,@k1,zz;
+  list primary,lres0,lres1,act,@lh,@wh;
+  map phi,psi,phi1,psi1;
+  ideal jmap,jmap1,jmap2,helpprim,@qh,@qht,ser1;
+  intvec @vh,@hilb;
+  string @ri;
+  poly @f;
+
+  // Debug
+  dbprint(printlevel - voice, "proc newZero_decomp");
+
+  if (dim(j)>0)
+  {
+    primary[1]=ideal(1);
+    primary[2]=ideal(1);
+    return(primary);
+  }
+  j=interred(j);
+
+  attrib(j,"isSB",1);
+
+  int nestLevel = 0;
+  if (size(#) > 0)
+  {
+    if (typeof(#[1]) == "string")
+    {
+      if (#[1] == "nest")
+      {
+        nestLevel = #[2];
+      }
+      # = list();
+    }
+  }
+
+  if(vdim(j)==deg(j[1]))
+  {
+    act=factor(j[1]);
+    for(@k=1;@k<=size(act[1]);@k++)
+    {
+      @qh=j;
+      if(@wr==0)
+      {
+        @qh[1]=act[1][@k]^act[2][@k];
+      }
+      else
+      {
+        @qh[1]=act[1][@k];
+      }
+      primary[2*@k-1]=interred(@qh);
+      @qh=j;
+      @qh[1]=act[1][@k];
+      primary[2*@k]=interred(@qh);
+      attrib( primary[2*@k-1],"isSB",1);
+
+      if((size(ser)>0)&&(size(reduce(ser,primary[2*@k-1],1))==0))
+      {
+        primary[2*@k-1]=ideal(1);
+        primary[2*@k]=ideal(1);
+      }
+    }
+    return(primary);
+  }
+
+  if(homog(j)==1)
+  {
+    primary[1]=j;
+    if((size(ser)>0)&&(size(reduce(ser,j,1))==0))
+    {
+      primary[1]=ideal(1);
+      primary[2]=ideal(1);
+      return(primary);
+    }
+    if(dim(j)==-1)
+    {
+      primary[1]=ideal(1);
+      primary[2]=ideal(1);
+    }
+    else
+    {
+      primary[2]=maxideal(1);
+    }
+    return(primary);
+  }
+
+//the first element in the standardbase is factorized
+  if(deg(j[1])>0)
+  {
+    act=factor(j[1]);
+    testFactor(act,j[1]);
+  }
+  else
+  {
+    primary[1]=ideal(1);
+    primary[2]=ideal(1);
+    return(primary);
+  }
+
+//with the factors new ideals (hopefully the primary decomposition)
+//are created
+  if(size(act[1])>1)
+  {
+    if(size(#)>1)
+    {
+      primary[1]=ideal(1);
+      primary[2]=ideal(1);
+      primary[3]=ideal(1);
+      primary[4]=ideal(1);
+      return(primary);
+    }
+    for(@k=1;@k<=size(act[1]);@k++)
+    {
+      if(@wr==0)
+      {
+        primary[2*@k-1]=std(j,act[1][@k]^act[2][@k]);
+      }
+      else
+      {
+        primary[2*@k-1]=std(j,act[1][@k]);
+      }
+      if((act[2][@k]==1)&&(vdim(primary[2*@k-1])==deg(act[1][@k])))
+      {
+        primary[2*@k]   = primary[2*@k-1];
+      }
+      else
+      {
+        primary[2*@k]   = primaryTest(primary[2*@k-1],act[1][@k]);
+      }
+    }
+  }
+  else
+  {
+    primary[1]=j;
+    if((size(#)>0)&&(act[2][1]>1))
+    {
+      act[2]=1;
+      primary[1]=std(primary[1],act[1][1]);
+    }
+    if(@wr!=0)
+    {
+      primary[1]=std(j,act[1][1]);
+    }
+    if((act[2][1]==1)&&(vdim(primary[1])==deg(act[1][1])))
+    {
+      primary[2]=primary[1];
+    }
+    else
+    {
+      primary[2]=primaryTest(primary[1],act[1][1]);
+    }
+  }
+
+  if(size(#)==0)
+  {
+    primary=splitPrimary(primary,ser,@wr,act);
+  }
+
+  if((voice>=6)&&(char(basering)<=181))
+  {
+    primary=splitCharp(primary);
+  }
+
+  if((@wr==2)&&(npars(basering)>0)&&(voice>=6)&&(char(basering)>0))
+  {
+  //the prime decomposition of Yokoyama in characteristic p
+    list ke,ek;
+    @k=0;
+    while(@k<size(primary)/2)
+    {
+      @k++;
+      if(size(primary[2*@k])==0)
+      {
+        ek=insepDecomp(primary[2*@k-1]);
+        primary=delete(primary,2*@k);
+        primary=delete(primary,2*@k-1);
+        @k--;
+      }
+      ke=ke+ek;
+    }
+    for(@k=1;@k<=size(ke);@k++)
+    {
+      primary[size(primary)+1]=ke[@k];
+      primary[size(primary)+1]=ke[@k];
+    }
+  }
+
+  if(nestLevel > 1){primary=extF(primary);}
+
+//test whether all ideals in the decomposition are primary and
+//in general position
+//if not after a random coordinate transformation of the last
+//variable the corresponding ideal is decomposed again.
+  if((npars(basering)>0)&&(nestLevel > 1))
+  {
+    poly randp;
+    for(zz=1;zz<nvars(basering);zz++)
+    {
+      randp=randp
+              +(random(0,5)*par(1)^2+random(0,5)*par(1)+random(0,5))*var(zz);
+    }
+    randp=randp+var(nvars(basering));
+  }
+  @k=0;
+  while(@k<(size(primary)/2))
+  {
+    @k++;
+    if (size(primary[2*@k])==0)
+    {
+      for(zz=1;zz<size(primary[2*@k-1])-1;zz++)
+      {
+        attrib(primary[2*@k-1],"isSB",1);
+        if(vdim(primary[2*@k-1])==deg(primary[2*@k-1][zz]))
+        {
+          primary[2*@k]=primary[2*@k-1];
+        }
+      }
+    }
+  }
+
+  @k=0;
+  ideal keep;
+  while(@k<(size(primary)/2))
+  {
+    @k++;
+    if (size(primary[2*@k])==0)
+    {
+      jmap=randomLast(100);
+      jmap1=maxideal(1);
+      jmap2=maxideal(1);
+      @qht=primary[2*@k-1];
+      if((npars(basering)>0)&&(nestLevel > 1))
+      {
+        jmap[size(jmap)]=randp;
+      }
+
+      for(@n=2;@n<=size(primary[2*@k-1]);@n++)
+      {
+        if(deg(lead(primary[2*@k-1][@n]))==1)
+        {
+          for(zz=1;zz<=nva;zz++)
+          {
+            if(lead(primary[2*@k-1][@n])/var(zz)!=0)
+            {
+              jmap1[zz]=-1/leadcoef(primary[2*@k-1][@n])*primary[2*@k-1][@n]
+                   +2/leadcoef(primary[2*@k-1][@n])*lead(primary[2*@k-1][@n]);
+              jmap2[zz]=primary[2*@k-1][@n];
+              @qht[@n]=var(zz);
+            }
+          }
+          jmap[nva]=subst(jmap[nva],lead(primary[2*@k-1][@n]),0);
+        }
+      }
+      if(size(subst(jmap[nva],var(1),0)-var(nva))!=0)
+      {
+        // jmap[nva]=subst(jmap[nva],var(1),0);
+        //hier geaendert +untersuchen!!!!!!!!!!!!!!
+      }
+      phi1=@P,jmap1;
+      phi=@P,jmap;
+      for(@n=1;@n<=nva;@n++)
+      {
+        jmap[@n]=-(jmap[@n]-2*var(@n));
+      }
+      psi=@P,jmap;
+      psi1=@P,jmap2;
+      @qh=phi(@qht);
+
+//=================== the new part ============================
+
+      @qh=groebner(@qh,"par2var");
+
+//=============================================================
+//       if(npars(@P)>0)
+//       {
+//          @ri= "ring @Phelp ="
+//                  +string(char(@P))+",
+//                   ("+varstr(@P)+","+parstr(@P)+",@t),(C,dp);";
+//       }
+//       else
+//       {
+//          @ri= "ring @Phelp ="
+//                  +string(char(@P))+",("+varstr(@P)+",@t),(C,dp);";
+//       }
+//       execute(@ri);
+//       ideal @qh=homog(imap(@P,@qht),@t);
+//
+//       ideal @qh1=std(@qh);
+//       @hilb=hilb(@qh1,1);
+//       @ri= "ring @Phelp1 ="
+//                  +string(char(@P))+",("+varstr(@Phelp)+"),(C,lp);";
+//       execute(@ri);
+//       ideal @qh=homog(imap(@P,@qh),@t);
+//       kill @Phelp;
+//       @qh=std(@qh,@hilb);
+//       @qh=subst(@qh,@t,1);
+//       setring @P;
+//       @qh=imap(@Phelp1,@qh);
+//       kill @Phelp1;
+//       @qh=clearSB(@qh);
+//       attrib(@qh,"isSB",1);
+//=============================================================
+
+      ser1=phi1(ser);
+      @lh=newZero_decomp (@qh,phi(ser1),@wr, list("nest", nestLevel + 1));
+
+      kill lres0;
+      list lres0;
+      if(size(@lh)==2)
+      {
+        helpprim=@lh[2];
+        lres0[1]=primary[2*@k-1];
+        ser1=psi(helpprim);
+        lres0[2]=psi1(ser1);
+        if(size(reduce(lres0[2],lres0[1],1))==0)
+        {
+          primary[2*@k]=primary[2*@k-1];
+          continue;
+        }
+      }
+      else
+      {
+        lres1=psi(@lh);
+        lres0=psi1(lres1);
+      }
+
+//=================== the new part ============================
+
+      primary=delete(primary,2*@k-1);
+      primary=delete(primary,2*@k-1);
+      @k--;
+      if(size(lres0)==2)
+      {
+        lres0[2]=groebner(lres0[2],"par2var");
+      }
+      else
+      {
+        for(@n=1;@n<=size(lres0)/2;@n++)
+        {
+          if(specialIdealsEqual(lres0[2*@n-1],lres0[2*@n])==1)
+          {
+            lres0[2*@n-1]=groebner(lres0[2*@n-1]);
+            lres0[2*@n]=lres0[2*@n-1];
+            attrib(lres0[2*@n],"isSB",1);
+          }
+          else
+          {
+            lres0[2*@n-1]=groebner(lres0[2*@n-1]);
+            lres0[2*@n]=groebner(lres0[2*@n]);
           }
         }
@@ -1294,6957 +8259,4 @@
    ideal i = p^2*q^3,(y-z3)^3,(x-yz+z4)^4;
    i=std(i);
-   list  pr= zero_decomp(i,ideal(0),0);
-   pr;
-}
-///////////////////////////////////////////////////////////////////////////////
-proc extF(list l,list #)
-{
-//zero_dimensional primary decomposition after finite field extension
-  def R=basering;
-  int p=char(R);
-
-  if((p==0)||(p>13)||(npars(R)>0)){return(l);}
-
-  int ex=3;
-  if(size(#)>0){ex=#[1];}
-
-  list peek,peek1;
-  while(size(l)>0)
-  {
-    if(size(l[2])==0)
-    {
-      peek[size(peek)+1]=l[1];
-    }
-    else
-    {
-      peek1[size(peek1)+1]=l[1];
-      peek1[size(peek1)+1]=l[2];
-    }
-    l=delete(l,1);
-    l=delete(l,1);
-  }
-  if(size(peek)==0){return(peek1);}
-
-  string gnir="ring RH=("+string(p)+"^"+string(ex)+",a),("+varstr(R)+"),lp;";
-  execute(gnir);
-  string mp="minpoly="+string(minpoly)+";";
-  gnir="ring RL=("+string(p)+",a),("+varstr(R)+"),lp;";
-  execute(gnir);
-  execute(mp);
-  list L=imap(R,peek);
-  list pr, keep;
-  int i;
-  for(i=1;i<=size(L);i++)
-  {
-    attrib(L[i],"isSB",1);
-    pr=zero_decomp(L[i],0,0);
-    keep=keep+pr;
-  }
-  for(i=1;i<=size(keep);i++)
-  {
-    keep[i]=simplify(keep[i],1);
-  }
-  mp="poly pp="+string(minpoly)+";";
-
-  string gnir1="ring RS="+string(p)+",("+varstr(R)+",a),lp;";
-  execute(gnir1);
-  execute(mp);
-  list L=imap(RL,keep);
-
-  for(i=1;i<=size(L);i++)
-  {
-    L[i]=eliminate(L[i]+ideal(pp),a);
-  }
-  i=0;
-  int j;
-  while(i<size(L)/2-1)
-  {
-    i++;
-    j=i;
-    while(j<size(L)/2)
-    {
-      j++;
-      if(idealsEqual(L[2*i-1],L[2*j-1]))
-      {
-        L=delete(L,2*j-1);
-        L=delete(L,2*j-1);
-        j--;
-      }
-    }
-  }
-  setring R;
-  list re=imap(RS,L);
-  re=re+peek1;
-
-  return(extF(re,ex+1));
-}
-
-///////////////////////////////////////////////////////////////////////////////
-proc zeroSp(ideal i)
-{
-//preparation for the separable closure
-//decomposition into ideals of special type
-//i.e. the minimal polynomials of every variable mod i are irreducible
-//returns a list of 2 lists: rr=pe,qe
-//the ideals in pe[l] are special, their special elements are in qe[l]
-//pe[l] is a dp-Groebnerbasis
-//the radical of the intersection of the pe[l] is equal to the radical of i
-
-  def R=basering;
-
-  //i has to be a reduced groebner basis
-  ideal F=finduni(i);
-
-  int j,k,l,ready;
-  list fa;
-  fa[1]=factorize(F[1],1);
-  poly te,ti;
-  ideal tj;
-  //avoid factorization of the same polynomial
-  for(j=2;j<=size(F);j++)
-  {
-    for(k=1;k<=j-1;k++)
-    {
-      ti=F[k];
-      te=subst(ti,var(k),var(j));
-      if(te==F[j])
-      {
-        tj=fa[k];
-        fa[j]=subst(tj,var(k),var(j));
-        ready=1;
-        break;
-      }
-    }
-    if(!ready)
-    {
-      fa[j]=factorize(F[j],1);
-    }
-    ready=0;
-  }
-  execute( "ring P=("+charstr(R)+"),("+varstr(R)+"),(C,dp);");
-  ideal i=imap(R,i);
-  if(npars(basering)==0)
-  {
-    ideal J=fglm(R,i);
-  }
-  else
-  {
-    ideal J=groebner(i,"par2var");
-  }
-  list fa=imap(R,fa);
-  list qe=J;          //collects a dp-Groebnerbasis of the special ideals
-  list keep=ideal(0); //collects the special elements
-
-  list re,em,ke;
-  ideal K,L;
-
-  for(j=1;j<=nvars(basering);j++)
-  {
-    for(l=1;l<=size(qe);l++)
-    {
-      for(k=1;k<=size(fa[j]);k++)
-      {
-        L=std(qe[l],fa[j][k]);
-        K=keep[l],fa[j][k];
-        if(deg(L[1])>0)
-        {
-          re[size(re)+1]=L;
-          ke[size(ke)+1]=K;
-        }
-      }
-    }
-    qe=re;
-    re=em;
-    keep=ke;
-    ke=em;
-  }
-
-  setring R;
-  list qe=imap(P,keep);
-  list pe=imap(P,qe);
-  for(l=1;l<=size(qe);l++)
-  {
-    qe[l]=simplify(qe[l],2);
-  }
-  list rr=pe,qe;
-  return(rr);
-}
-///////////////////////////////////////////////////////////////////////////////
-
-proc zeroSepClos(ideal I,ideal F)
-{
-//computes the separable closure of the special ideal I
-//F is the set of special elements of I
-//returns the separable closure sc(I) of I and an intvec v
-//such that sc(I)=preimage(frobenius definde by v)
-//i.e. var(i)----->var(i)^(p^v[i])
-
-  if(homog(I)==1){return(maxideal(1));}
-
-  //assume F[i] irreducible in I and depending only on var(i)
-
-  def R=basering;
-  int n=nvars(R);
-  int p=char(R);
-  intvec v;
-  v[n]=0;
-  int i,k;
-  list l;
-
-  for(i=1;i<=n;i++)
-  {
-    l[i]=sep(F[i],i);
-    F[i]=l[i][1];
-    if(l[i][2]>k){k=l[i][2];}
-  }
-
-  if(k==0){return(list(I,v));}        //the separable case
-  ideal m;
-
-  for(i=1;i<=n;i++)
-  {
-    m[i]=var(i)^(p^l[i][2]);
-    v[i]=l[i][2];
-  }
-  map phi=R,m;
-  ideal J=preimage(R,phi,I);
-  return(list(J,v));
-}
-///////////////////////////////////////////////////////////////////////////////
-
-proc insepDecomp(ideal i)
-{
-//decomposes i into special ideals
-//computes the prime decomposition of the special ideals
-//and transforms it back to a decomposition of i
-
-  def R=basering;
-  list pr=zeroSp(i);
-  int l,k;
-  list re,wo,qr;
-  ideal m=maxideal(1);
-  ideal K;
-  map phi=R,m;
-  int p=char(R);
-  intvec op=option(get);
-
-  for(l=1;l<=size(pr[1]);l++)
-  {
-    wo=zeroSepClos(pr[1][l],pr[2][l]);
-    for(k=1;k<=nvars(basering);k++)
-    {
-      m[k]=var(k)^(p^wo[2][k]);
-    }
-    phi=R,m;
-    qr=decomp(wo[1],2);
-
-    option(redSB);
-    for(k=1;k<=size(qr)/2;k++)
-    {
-      K=qr[2*k];
-      K=phi(K);
-      K=groebner(K);
-      re[size(re)+1]=zeroRad(K);
-    }
-    option(noredSB);
-  }
-  option(set,op);
-  return(re);
-}
-
-
-///////////////////////////////////////////////////////////////////////////////
-
-static proc clearSB (ideal i,list #)
-"USAGE:   clearSB(i); i ideal which is SB ordered by monomial ordering
-RETURN:  ideal = minimal SB
-NOTE:
-EXAMPLE: example clearSB; shows an example
-"
-{
-  int k,j;
-  poly m;
-  int c=size(i);
-
-  if(size(#)==0)
-  {
-    for(j=1;j<c;j++)
-    {
-      if(deg(i[j])==0)
-      {
-        i=ideal(1);
-        return(i);
-      }
-      if(deg(i[j])>0)
-      {
-        m=lead(i[j]);
-        for(k=j+1;k<=c;k++)
-        {
-          if(size(lead(i[k])/m)>0)
-          {
-            i[k]=0;
-          }
-        }
-      }
-    }
-  }
-  else
-  {
-    j=0;
-    while(j<c-1)
-    {
-      j++;
-      if(deg(i[j])==0)
-      {
-        i=ideal(1);
-        return(i);
-      }
-      if(deg(i[j])>0)
-      {
-        m=lead(i[j]);
-        for(k=j+1;k<=c;k++)
-        {
-          if(size(lead(i[k])/m)>0)
-          {
-            if((leadexp(m)!=leadexp(i[k]))||(#[j]<=#[k]))
-            {
-              i[k]=0;
-            }
-            else
-            {
-              i[j]=0;
-              break;
-            }
-          }
-        }
-      }
-    }
-  }
-  return(simplify(i,2));
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring  r = (0,a,b),(x,y,z),dp;
-   ideal i=ax2+y,a2x+y,bx;
-   list l=1,2,1;
-   ideal j=clearSB(i,l);
-   j;
-}
-
-///////////////////////////////////////////////////////////////////////////////
-static proc clearSBNeu (ideal i,list #)
-"USAGE:   clearSB(i); i ideal which is SB ordered by monomial ordering
-RETURN:  ideal = minimal SB
-NOTE:
-EXAMPLE: example clearSB; shows an example
-"
-{
-  int k,j;
-  intvec m,n,v,w;
-  int c=size(i);
-  w=leadexp(0);
-  v[size(i)]=0;
-
-  j=0;
-  while(j<c-1)
-  {
-    j++;
-    if(deg(i[j])>=0)
-    {
-      m=leadexp(i[j]);
-      for(k=j+1;k<=c;k++)
-      {
-        n=leadexp(i[k]);
-        if(n!=w)
-        {
-          if(((m==n)&&(#[j]>#[k]))||((teilt(n,m))&&(n!=m)))
-          {
-            i[j]=0;
-            v[j]=1;
-            break;
-          }
-          if(((m==n)&&(#[j]<=#[k]))||((teilt(m,n))&&(n!=m)))
-          {
-            i[k]=0;
-            v[k]=1;
-          }
-        }
-      }
-    }
-  }
-  return(v);
-}
-
-static proc teilt(intvec a, intvec b)
-{
-  int i;
-  for(i=1;i<=size(a);i++)
-  {
-    if(a[i]>b[i]){return(0);}
-  }
-  return(1);
-}
-///////////////////////////////////////////////////////////////////////////////
-
-static proc independSet (ideal j)
-"USAGE:   independentSet(i); i ideal
-RETURN:  list = new varstring with the independent set at the end,
-                ordstring with the corresponding block ordering,
-                the integer where the independent set starts in the varstring
-NOTE:
-EXAMPLE: example independentSet; shows an example
-"
-{
-  int n,k,di;
-  list resu,hilf;
-  string var1,var2;
-  list v=indepSet(j,1);
-
-  for(n=1;n<=size(v);n++)
-  {
-    di=0;
-    var1="";
-    var2="";
-    for(k=1;k<=size(v[n]);k++)
-    {
-      if(v[n][k]!=0)
-      {
-        di++;
-        var2=var2+"var("+string(k)+"),";
-      }
-      else
-      {
-        var1=var1+"var("+string(k)+"),";
-      }
-    }
-    if(di>0)
-    {
-      var1=var1+var2;
-      var1=var1[1..size(var1)-1];
-      hilf[1]=var1;
-      hilf[2]="lp";
-      //"lp("+string(nvars(basering)-di)+"),dp("+string(di)+")";
-      hilf[3]=di;
-      resu[n]=hilf;
-    }
-    else
-    {
-      resu[n]=varstr(basering),ordstr(basering),0;
-    }
-  }
-  return(resu);
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring s1=(0,x,y),(a,b,c,d,e,f,g),lp;
-   ideal i=ea-fbg,fa+be,ec-fdg,fc+de;
-   i=std(i);
-   list  l=independSet(i);
-   l;
-   i=i,g;
-   l=independSet(i);
-   l;
-
-   ring s=0,(x,y,z),lp;
-   ideal i=z,yx;
-   list l=independSet(i);
-   l;
-
-
-}
-///////////////////////////////////////////////////////////////////////////////
-
-static proc maxIndependSet (ideal j)
-"USAGE:   maxIndependentSet(i); i ideal
-RETURN:  list = new varstring with the maximal independent set at the end,
-                ordstring with the corresponding block ordering,
-                the integer where the independent set starts in the varstring
-NOTE:
-EXAMPLE: example maxIndependentSet; shows an example
-"
-{
-  int n,k,di;
-  list resu,hilf;
-  string var1,var2;
-  list v=indepSet(j,0);
-
-  for(n=1;n<=size(v);n++)
-  {
-    di=0;
-    var1="";
-    var2="";
-    for(k=1;k<=size(v[n]);k++)
-    {
-      if(v[n][k]!=0)
-      {
-        di++;
-        var2=var2+"var("+string(k)+"),";
-      }
-      else
-      {
-        var1=var1+"var("+string(k)+"),";
-      }
-    }
-    if(di>0)
-    {
-      var1=var1+var2;
-      var1=var1[1..size(var1)-1];
-      hilf[1]=var1;
-      hilf[2]="lp";
-      hilf[3]=di;
-      resu[n]=hilf;
-    }
-    else
-    {
-      resu[n]=varstr(basering),ordstr(basering),0;
-    }
-  }
-  return(resu);
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring s1=(0,x,y),(a,b,c,d,e,f,g),lp;
-   ideal i=ea-fbg,fa+be,ec-fdg,fc+de;
-   i=std(i);
-   list  l=maxIndependSet(i);
-   l;
-   i=i,g;
-   l=maxIndependSet(i);
-   l;
-
-   ring s=0,(x,y,z),lp;
-   ideal i=z,yx;
-   list l=maxIndependSet(i);
-   l;
-
-
-}
-
-///////////////////////////////////////////////////////////////////////////////
-
-static proc prepareQuotientring (int nnp)
-"USAGE:   prepareQuotientring(nnp); nnp int
-RETURN:  string = to define Kvar(nnp+1),...,var(nvars)[..rest ]
-NOTE:
-EXAMPLE: example independentSet; shows an example
-"
-{
-  ideal @ih,@jh;
-  int npar=npars(basering);
-  int @n;
-
-  string quotring= "ring quring = ("+charstr(basering);
-  for(@n=nnp+1;@n<=nvars(basering);@n++)
-  {
-    quotring=quotring+",var("+string(@n)+")";
-    @ih=@ih+var(@n);
-  }
-
-  quotring=quotring+"),(var(1)";
-  @jh=@jh+var(1);
-  for(@n=2;@n<=nnp;@n++)
-  {
-    quotring=quotring+",var("+string(@n)+")";
-    @jh=@jh+var(@n);
-  }
-  quotring=quotring+"),(C,lp);";
-
-  return(quotring);
-
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring s1=(0,x),(a,b,c,d,e,f,g),lp;
-   def @Q=basering;
-   list l= prepareQuotientring(3);
-   l;
-   execute(l[1]);
-   execute(l[2]);
-   basering;
-   phi;
-   setring @Q;
-
-}
-
-///////////////////////////////////////////////////////////////////////////////
-static proc cleanPrimary(list l)
-{
-  int i,j;
-  list lh;
-  for(i=1;i<=size(l)/2;i++)
-  {
-    if(deg(l[2*i-1][1])>0)
-    {
-      j++;
-      lh[j]=l[2*i-1];
-      j++;
-      lh[j]=l[2*i];
-    }
-  }
-  return(lh);
-}
-///////////////////////////////////////////////////////////////////////////////
-
-
-proc minAssPrimesold(ideal i, list #)
-"USAGE:   minAssPrimes(i); i ideal
-         minAssPrimes(i,1); i ideal  (to use also the factorizing Groebner)
-RETURN:  list = the minimal associated prime ideals of i
-EXAMPLE: example minAssPrimes; shows an example
-"
-{
-  def @P=basering;
-  if(size(i)==0){return(list(ideal(0)));}
-  list qr=simplifyIdeal(i);
-  map phi=@P,qr[2];
-  i=qr[1];
-
-  execute ("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),("
-             +ordstr(basering)+");");
-
-
-  ideal i=fetch(@P,i);
-  if(size(#)==0)
-  {
-    int @wr;
-    list tluser,@res;
-    list primary=decomp(i,2);
-
-    @res[1]=primary;
-
-    tluser=union(@res);
-    setring @P;
-    list @res=imap(gnir,tluser);
-    return(phi(@res));
-  }
-  list @res,empty;
-  ideal ser;
-  option(redSB);
-  list @pr=facstd(i);
-  //if(size(@pr)==1)
-//   {
-//      attrib(@pr[1],"isSB",1);
-//      if((dim(@pr[1])==0)&&(homog(@pr[1])==1))
-//      {
-//         setring @P;
-//         list @res=maxideal(1);
-//         return(phi(@res));
-//      }
-//      if(dim(@pr[1])>1)
-//      {
-//         setring @P;
-//        // kill gnir;
-//         execute ("ring gnir1 = ("+charstr(basering)+"),
-//                              ("+varstr(basering)+"),(C,lp);");
-//         ideal i=fetch(@P,i);
-//         list @pr=facstd(i);
-//        // ideal ser;
-//         setring gnir;
-//         @pr=fetch(gnir1,@pr);
-//         kill gnir1;
-//      }
-//   }
-  option(noredSB);
-  int j,k,odim,ndim,count;
-  attrib(@pr[1],"isSB",1);
-  if(#[1]==77)
-  {
-    odim=dim(@pr[1]);
-    count=1;
-    intvec pos;
-    pos[size(@pr)]=0;
-    for(j=2;j<=size(@pr);j++)
-    {
-      attrib(@pr[j],"isSB",1);
-      ndim=dim(@pr[j]);
-      if(ndim>odim)
-      {
-        for(k=count;k<=j-1;k++)
-        {
-          pos[k]=1;
-        }
-        count=j;
-        odim=ndim;
-      }
-      if(ndim<odim)
-      {
-        pos[j]=1;
-      }
-    }
-    for(j=1;j<=size(@pr);j++)
-    {
-      if(pos[j]!=1)
-      {
-        @res[j]=decomp(@pr[j],2);
-      }
-      else
-      {
-        @res[j]=empty;
-      }
-    }
-  }
-  else
-  {
-    ser=ideal(1);
-    for(j=1;j<=size(@pr);j++)
-    {
-//@pr[j];
-//pause();
-      @res[j]=decomp(@pr[j],2);
-//       @res[j]=decomp(@pr[j],2,@pr[j],ser);
-//       for(k=1;k<=size(@res[j]);k++)
-//       {
-//          ser=intersect(ser,@res[j][k]);
-//       }
-    }
-  }
-
-  @res=union(@res);
-  setring @P;
-  list @res=imap(gnir,@res);
-  return(phi(@res));
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring  r = 32003,(x,y,z),lp;
-   poly  p = z2+1;
-   poly  q = z4+2;
-   ideal i = p^2*q^3,(y-z3)^3,(x-yz+z4)^4;
-   list pr= minAssPrimes(i);  pr;
-
-   minAssPrimes(i,1);
-}
-
-static proc primT(ideal i)
-{
-  //assumes that all generators of i are irreducible
-  //i is standard basis
-
-  attrib(i,"isSB",1);
-  int j=size(i);
-  int k;
-  while(j>0)
-  {
-    if(deg(i[j])>1){break;}
-    j--;
-  }
-  if(j==0){return(1);}
-  if(deg(i[j])==vdim(i)){return(1);}
-  return(0);
-}
-
-static proc minAssPrimes(ideal i, list #)
-"USAGE:   minAssPrimes(i); i ideal
-      Optional parameters in list #: (can be entered in any order)
-      0, "facstd"   ->   uses facstd to first decompose the ideal
-      1, "noFacstd" ->  does not use facstd (default)
-      "SL" ->     the new algorithm is used (default)
-      "GTZ" ->     the old algorithm is used
-RETURN:  list = the minimal associated prime ideals of i
-EXAMPLE: example minAssPrimes; shows an example
-"
-{
-  if(size(i) == 0){return(list(ideal(0)));}
-  string algorithm;    // Algorithm to be used
-  string facstdOption;    // To uses proc facstd
-  int j;          // Counter
-  def P0 = basering;
-  list Pl=ringlist(P0);
-  intvec dp_w;
-  for(j=nvars(P0);j>0;j--) {dp_w[j]=1;}
-  Pl[3]=list(list("dp",dp_w),list("C",0));
-  def P=ring(Pl);
-  setring P;
-  ideal i=imap(P0,i);
-
-  // Set input parameters
-  algorithm = "SL";         // Default: SL algorithm
-  facstdOption = "noFacstd";    // Default: facstd is not used
-  if(size(#) > 0)
-  {
-    int valid;
-    for(j = 1; j <= size(#); j++)
-    {
-      valid = 0;
-      if((typeof(#[j]) == "int") or (typeof(#[j]) == "number"))
-      {
-        if (#[j] == 0) {facstdOption = "noFacstd"; valid = 1;}    // If #[j] == 0, facstd is not used.
-        if (#[j] == 1) {facstdOption = "facstd";   valid = 1;}    // If #[j] == 1, facstd is used.
-      }
-      if(typeof(#[j]) == "string")
-      {
-        if(#[j] == "GTZ" || #[j] == "SL")
-        {
-          algorithm = #[j];
-          valid = 1;
-        }
-        if(#[j] == "noFacstd" || #[j] == "facstd")
-        {
-          facstdOption = #[j];
-          valid = 1;
-        }
-      }
-      if(valid == 0)
-      {
-        dbprint(1, "Warning! The following input parameter was not recognized:", #[j]);
-      }
-    }
-  }
-
-  list q = simplifyIdeal(i);
-  list re = maxideal(1);
-  int a, k;
-  intvec op = option(get);
-  map phi = P,q[2];
-
-  list result;
-
-  if(npars(P) == 0){option(redSB);}
-
-  if(attrib(i,"isSB")!=1)
-  {
-    i=groebner(q[1]);
-  }
-  else
-  {
-    for(j=1;j<=nvars(basering);j++)
-    {
-      if(q[2][j]!=var(j)){k=1;break;}
-    }
-    if(k)
-    {
-      i=groebner(q[1]);
-    }
-  }
-
-  if(dim(i) == -1){setring P0;return(ideal(1));}
-  if((dim(i) == 0) && (npars(P) == 0))
-  {
-    int di = vdim(i);
-    execute ("ring gnir=("+charstr(P)+"),("+varstr(P)+"),lp;");
-    ideal J = std(imap(P,i));
-    attrib(J, "isSB", 1);
-    if(vdim(J) != di)
-    {
-      J = fglm(P, i);
-    }
-    list pr = triangMH(J, 2);
-    list qr, re;
-
-    for(k = 1; k <= size(pr); k++)
-    {
-      if(primT(pr[k]))
-      {
-        re[size(re) + 1] = pr[k];
-      }
-      else
-      {
-        attrib(pr[k], "isSB", 1);
-        // Lines changed
-        if (algorithm == "GTZ")
-        {
-          qr = decomp(pr[k], 2);
-        }
-        else
-        {
-          qr = minAssSL(pr[k]);
-        }
-        for(j = 1; j <= size(qr) / 2; j++)
-        {
-          re[size(re) + 1] = qr[2 * j];
-        }
-      }
-    }
-    setring P;
-    re = imap(gnir, re);
-    re=phi(re);
-    option(set, op);
-    setring(P0);
-    list re=imap(P,re);
-    return(re);
-  }
-
-  // Lines changed
-  if ((facstdOption == "noFacstd") || (dim(i) == 0))
-  {
-    if (algorithm == "GTZ")
-    {
-      re[1] = decomp(i, 2);
-    }
-    else
-    {
-      re[1] = minAssSL(i);
-    }
-    re = union(re);
-    option(set, op);
-    re=phi(re);
-    setring(P0);
-    list re=imap(P,re);
-    return(re);
-  }
-  q = facstd(i);
-
-/*
-  if((size(q) == 1) && (dim(i) > 1))
-  {
-    execute ("ring gnir=("+charstr(P)+"),("+varstr(P)+"),lp;");
-    list p = facstd(fetch(P, i));
-    if(size(p) > 1)
-    {
-      a = 1;
-      setring P;
-      q = fetch(gnir,p);
-    }
-    else
-    {
-      setring P;
-    }
-    kill gnir;
-  }
-*/
-  option(set,op);
-  // Debug
-  dbprint(printlevel - voice, "Components returned by facstd", size(q), q);
-  for(j = 1; j <= size(q); j++)
-  {
-    if(a == 0){attrib(q[j], "isSB", 1);}
-    // Debug
-    dbprint(printlevel - voice, "We compute the decomp of component", j);
-    // Lines changed
-    if (algorithm == "GTZ")
-    {
-      re[j] = decomp(q[j], 2);
-    }
-    else
-    {
-      re[j] = minAssSL(q[j]);
-    }
-    // Debug
-    dbprint(printlevel - voice, "Number of components obtained for this component:", size(re[j]) / 2);
-    dbprint(printlevel - voice, "re[j]:", re[j]);
-  }
-  re = union(re);
-  re=phi(re);
-  setring(P0);
-  list re=imap(P,re);
-  return(re);
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring  r = 32003,(x,y,z),lp;
-   poly  p = z2+1;
-   poly  q = z4+2;
-   ideal i = p^2*q^3,(y-z3)^3,(x-yz+z4)^4;
-   list pr= minAssPrimes(i);  pr;
-
-   minAssPrimes(i,1);
-}
-
-static proc union(list li)
-{
-  int i,j,k;
-
-  def P=basering;
-
-  execute("ring ir = ("+charstr(basering)+"),("+varstr(basering)+"),(C,lp);");
-  list l=fetch(P,li);
-  list @erg;
-
-  for(k=1;k<=size(l);k++)
-  {
-    for(j=1;j<=size(l[k])/2;j++)
-    {
-      if(deg(l[k][2*j][1])!=0)
-      {
-        i++;
-        @erg[i]=l[k][2*j];
-      }
-    }
-  }
-
-  list @wos;
-  i=0;
-  ideal i1,i2;
-  while(i<size(@erg)-1)
-  {
-    i++;
-    k=i+1;
-    i1=lead(@erg[i]);
-    attrib(i1,"isSB",1);
-    attrib(@erg[i],"isSB",1);
-
-    while(k<=size(@erg))
-    {
-      if(deg(@erg[i][1])==0)
-      {
-        break;
-      }
-      i2=lead(@erg[k]);
-      attrib(@erg[k],"isSB",1);
-      attrib(i2,"isSB",1);
-
-      if(size(reduce(i1,i2,1))==0)
-      {
-        if(size(reduce(@erg[i],@erg[k],1))==0)
-        {
-          @erg[k]=ideal(1);
-          i2=ideal(1);
-        }
-      }
-      if(size(reduce(i2,i1,1))==0)
-      {
-        if(size(reduce(@erg[k],@erg[i],1))==0)
-        {
-          break;
-        }
-      }
-      k++;
-      if(k>size(@erg))
-      {
-        @wos[size(@wos)+1]=@erg[i];
-      }
-    }
-  }
-  if(deg(@erg[size(@erg)][1])!=0)
-  {
-    @wos[size(@wos)+1]=@erg[size(@erg)];
-  }
-  setring P;
-  list @ser=fetch(ir,@wos);
-  return(@ser);
-}
-///////////////////////////////////////////////////////////////////////////////
-proc equidim(ideal i,list #)
-"USAGE:  equidim(i) or equidim(i,1) ; i ideal
-RETURN: list of equidimensional ideals a[1],...,a[s] with:
-        - a[s] the equidimensional locus of i, i.e. the intersection
-          of the primary ideals of dimension of i
-        - a[1],...,a[s-1] the lower dimensional equidimensional loci.
-NOTE:    An embedded component q (primary ideal) of i can be replaced in the
-         decomposition by a primary ideal q1 with the same radical as q. @*
-         @code{equidim(i,1)} uses the algorithm of Eisenbud/Huneke/Vasconcelos.
-
-EXAMPLE:example equidim; shows an example
-"
-{
-  if(attrib(basering,"global")!=1)
-  {
-    ERROR(
-      "// Not implemented for this ordering, please change to global ordering."
-    );
-  }
-  intvec op ;
-  def  P = basering;
-  list eq;
-  intvec w;
-  int n,m;
-  int g=size(i);
-  int a=attrib(i,"isSB");
-  int homo=homog(i);
-  if(size(#)!=0)
-  {
-     m=1;
-  }
-
-  if(((homo==1)||(a==1))&&(find(ordstr(basering),"l")==0)
-                                &&(find(ordstr(basering),"s")==0))
-  {
-    execute("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),("
-                              +ordstr(basering)+");");
-    ideal i=imap(P,i);
-    ideal j=i;
-    if(a==1)
-    {
-      attrib(j,"isSB",1);
-    }
-    else
-    {
-      j=groebner(i);
-    }
-  }
-  else
-  {
-    execute("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),dp;");
-    ideal i=imap(P,i);
-    ideal j=groebner(i);
-  }
-  if(homo==1)
-  {
-    for(n=1;n<=nvars(basering);n++)
-    {
-      w[n]=ord(var(n));
-    }
-    intvec hil=hilb(j,1,w);
-  }
-
-  if ((dim(j)==-1)||(size(j)==0)||(nvars(basering)==1)
-                  ||(dim(j)==0)||(dim(j)+g==nvars(basering)))
-  {
-    setring P;
-    eq[1]=i;
-    return(eq);
-  }
-
-  if(m==0)
-  {
-    ideal k=equidimMax(j);
-  }
-  else
-  {
-    ideal k=equidimMaxEHV(j);
-  }
-  if(size(reduce(k,j,1))==0)
-  {
-    setring P;
-    eq[1]=i;
-    kill gnir;
-    return(eq);
-  }
-  op=option(get);
-  option(returnSB);
-  j=quotient(j,k);
-  option(set,op);
-
-  list equi=equidim(j);
-  if(deg(equi[size(equi)][1])<=0)
-  {
-    equi[size(equi)]=k;
-  }
-  else
-  {
-    equi[size(equi)+1]=k;
-  }
-  setring P;
-  eq=imap(gnir,equi);
-  kill gnir;
-  return(eq);
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring  r = 32003,(x,y,z),dp;
-   ideal i = intersect(ideal(z),ideal(x,y),ideal(x2,z2),ideal(x5,y5,z5));
-   equidim(i);
-}
-
-///////////////////////////////////////////////////////////////////////////////
-proc equidimMax(ideal i)
-"USAGE:  equidimMax(i); i ideal
-RETURN:  ideal of equidimensional locus (of maximal dimension) of i.
-EXAMPLE: example equidimMax; shows an example
-"
-{
-  if(attrib(basering,"global")!=1)
-  {
-    ERROR(
-      "// Not implemented for this ordering, please change to global ordering."
-    );
-  }
-  def  P = basering;
-  ideal eq;
-  intvec w;
-  int n;
-  int g=size(i);
-  int a=attrib(i,"isSB");
-  int homo=homog(i);
-
-  if(((homo==1)||(a==1))&&(find(ordstr(basering),"l")==0)
-                                &&(find(ordstr(basering),"s")==0))
-  {
-    execute("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),("
-                              +ordstr(basering)+");");
-    ideal i=imap(P,i);
-    ideal j=i;
-    if(a==1)
-    {
-      attrib(j,"isSB",1);
-    }
-    else
-    {
-      j=groebner(i);
-    }
-  }
-  else
-  {
-    execute("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),dp;");
-    ideal i=imap(P,i);
-    ideal j=groebner(i);
-  }
-  list indep;
-  ideal equ,equi;
-  if(homo==1)
-  {
-    for(n=1;n<=nvars(basering);n++)
-    {
-      w[n]=ord(var(n));
-    }
-    intvec hil=hilb(j,1,w);
-  }
-  if ((dim(j)==-1)||(size(j)==0)||(nvars(basering)==1)
-                  ||(dim(j)==0)||(dim(j)+g==nvars(basering)))
-  {
-    setring P;
-    return(i);
-  }
-
-  indep=maxIndependSet(j);
-
-  execute("ring gnir1 = ("+charstr(basering)+"),("+indep[1][1]+"),("
-                              +indep[1][2]+");");
-  if(homo==1)
-  {
-    ideal j=std(imap(gnir,j),hil,w);
-  }
-  else
-  {
-    ideal j=groebner(imap(gnir,j));
-  }
-  string quotring=prepareQuotientring(nvars(basering)-indep[1][3]);
-  execute(quotring);
-  ideal j=imap(gnir1,j);
-  kill gnir1;
-  j=clearSB(j);
-  ideal h;
-  for(n=1;n<=size(j);n++)
-  {
-    h[n]=leadcoef(j[n]);
-  }
-  setring gnir;
-  ideal h=imap(quring,h);
-  kill quring;
-
-  list l=minSat(j,h);
-
-  if(deg(l[2])>0)
-  {
-    equ=l[1];
-    attrib(equ,"isSB",1);
-    j=std(j,l[2]);
-
-    if(dim(equ)==dim(j))
-    {
-      equi=equidimMax(j);
-      equ=interred(intersect(equ,equi));
-    }
-  }
-  else
-  {
-    equ=i;
-  }
-
-  setring P;
-  eq=imap(gnir,equ);
-  kill gnir;
-  return(eq);
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring  r = 32003,(x,y,z),dp;
-   ideal i = intersect(ideal(z),ideal(x,y),ideal(x2,z2),ideal(x5,y5,z5));
-   equidimMax(i);
-}
-///////////////////////////////////////////////////////////////////////////////
-static proc islp()
-{
-  string s=ordstr(basering);
-  int n=find(s,"lp");
-  if(!n){return(0);}
-  int k=find(s,",");
-  string t=s[k+1..size(s)];
-  int l=find(t,",");
-  t=s[1..k-1];
-  int m=find(t,",");
-  if(l+m){return(0);}
-  return(1);
-}
-///////////////////////////////////////////////////////////////////////////////
-
-proc algeDeco(ideal i, int w)
-{
-//reduces primery decomposition over algebraic extensions to
-//the other cases
-  def R=basering;
-  int n=nvars(R);
-
-//---Anfang Provisorium
-  if((size(i)==2) && (w==2))
-  {
-    option(redSB);
-    ideal J=std(i);
-    option(noredSB);
-    if((size(J)==2)&&(deg(J[1])==1))
-    {
-      ideal keep;
-      poly f;
-      int j;
-      for(j=1;j<=nvars(basering);j++)
-      {
-        f=J[2];
-        while((f/var(j))*var(j)-f==0)
-        {
-          f=f/var(j);
-          keep=keep,var(j);
-        }
-        J[2]=f;
-      }
-      ideal K=factorize(J[2],1);
-      if(deg(K[1])==0){K=0;}
-      K=K+std(keep);
-      ideal L;
-      list resu;
-      for(j=1;j<=size(K);j++)
-      {
-        L=J[1],K[j];
-        resu[j]=L;
-      }
-      return(resu);
-    }
-  }
-//---Ende Provisorium
-  string mp="poly p="+string(minpoly)+";";
-  string gnir="ring RH="+string(char(R))+",("+varstr(R)+","+string(par(1))
-                +"),dp;";
-  execute(gnir);
-  execute(mp);
-  ideal i=imap(R,i);
-  ideal I=subst(i,var(nvars(basering)),0);
-  int j;
-  for(j=1;j<=ncols(i);j++)
-  {
-    if(i[j]!=I[j]){break;}
-  }
-  if((j>ncols(i))&&(deg(p)==1))
-  {
-    setring R;
-    kill RH;
-    kill gnir;
-    string gnir="ring RH="+string(char(R))+",("+varstr(R)+"),dp;";
-    execute(gnir);
-    ideal i=imap(R,i);
-    ideal J;
-  }
-  else
-  {
-    i=i,p;
-  }
-  list pr;
-
-  if(w==0)
-  {
-    pr=decomp(i);
-  }
-  if(w==1)
-  {
-    pr=prim_dec(i,1);
-    pr=reconvList(pr);
-  }
-  if(w==2)
-  {
-    pr=minAssPrimes(i);
-  }
-  if(n<nvars(basering))
-  {
-    gnir="ring RS="+string(char(R))+",("+varstr(RH)
-                +"),(dp("+string(n)+"),lp);";
-    execute(gnir);
-    list pr=imap(RH,pr);
-    ideal K;
-    for(j=1;j<=size(pr);j++)
-    {
-      K=groebner(pr[j]);
-      K=K[2..size(K)];
-      pr[j]=K;
-    }
-    setring R;
-    list pr=imap(RS,pr);
-  }
-  else
-  {
-    setring R;
-    list pr=imap(RH,pr);
-  }
-  list re;
-  if(w==2)
-  {
-    re=pr;
-  }
-  else
-  {
-    re=convList(pr);
-  }
-  return(re);
-}
-
-///////////////////////////////////////////////////////////////////////////////
-static proc decomp(ideal i,list #)
-"USAGE:  decomp(i); i ideal  (for primary decomposition)   (resp.
-         decomp(i,1);        (for the associated primes of dimension of i) )
-         decomp(i,2);        (for the minimal associated primes) )
-         decomp(i,3);        (for the absolute primary decomposition) )
-RETURN:  list = list of primary ideals and their associated primes
-         (at even positions in the list)
-         (resp. a list of the minimal associated primes)
-NOTE:    Algorithm of Gianni/Trager/Zacharias
-EXAMPLE: example decomp; shows an example
-"
-{
-  intvec op,@vv;
-  def  @P = basering;
-  list primary,indep,ltras;
-  intvec @vh,isat,@w;
-  int @wr,@k,@n,@m,@n1,@n2,@n3,homo,seri,keepdi,abspri,ab,nn;
-  ideal peek=i;
-  ideal ser,tras;
-  int isS=(attrib(i,"isSB")==1);
-
-
-  if(size(#)>0)
-  {
-    if((#[1]==1)||(#[1]==2)||(#[1]==3))
-    {
-      @wr=#[1];
-      if(@wr==3){abspri=1;@wr=0;}
-      if(size(#)>1)
-      {
-        seri=1;
-        peek=#[2];
-        ser=#[3];
-      }
-    }
-    else
-    {
-      seri=1;
-      peek=#[1];
-      ser=#[2];
-    }
-  }
-  if(abspri)
-  {
-    list absprimary,abskeep,absprimarytmp,abskeeptmp;
-  }
-  homo=homog(i);
-  if(homo==1)
-  {
-    if(attrib(i,"isSB")!=1)
-    {
-      //ltras=mstd(i);
-      tras=groebner(i);
-      ltras=tras,tras;
-      attrib(ltras[1],"isSB",1);
-    }
-    else
-    {
-      ltras=i,i;
-      attrib(ltras[1],"isSB",1);
-    }
-    tras=ltras[1];
-    attrib(tras,"isSB",1);
-    if(dim(tras)==0)
-    {
-      primary[1]=ltras[2];
-      primary[2]=maxideal(1);
-      if(@wr>0)
-      {
-        list l;
-        l[1]=maxideal(1);
-        l[2]=maxideal(1);
-        return(l);
-      }
-      return(primary);
-    }
-    for(@n=1;@n<=nvars(basering);@n++)
-    {
-      @w[@n]=ord(var(@n));
-    }
-    intvec @hilb=hilb(tras,1,@w);
-    intvec keephilb=@hilb;
-  }
-
-  //----------------------------------------------------------------
-  //i is the zero-ideal
-  //----------------------------------------------------------------
-
-  if(size(i)==0)
-  {
-    primary=i,i;
-    return(primary);
-  }
-
-  //----------------------------------------------------------------
-  //pass to the lexicographical ordering and compute a standardbasis
-  //----------------------------------------------------------------
-
-  int lp=islp();
-
-  execute("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),(C,lp);");
-  op=option(get);
-  option(redSB);
-
-  ideal ser=fetch(@P,ser);
-
-  if(homo==1)
-  {
-    if(!lp)
-    {
-      ideal @j=std(fetch(@P,i),@hilb,@w);
-    }
-    else
-    {
-      ideal @j=fetch(@P,tras);
-      attrib(@j,"isSB",1);
-    }
-  }
-  else
-  {
-    if(lp&&isS)
-    {
-      ideal @j=fetch(@P,i);
-      attrib(@j,"isSB",1);
-    }
-    else
-    {
-      ideal @j=groebner(fetch(@P,i));
-    }
-  }
-  option(set,op);
-  if(seri==1)
-  {
-    ideal peek=fetch(@P,peek);
-    attrib(peek,"isSB",1);
-  }
-  else
-  {
-    ideal peek=@j;
-  }
-  if((size(ser)==0)&&(!abspri))
-  {
-    ideal fried;
-    @n=size(@j);
-    for(@k=1;@k<=@n;@k++)
-    {
-      if(deg(lead(@j[@k]))==1)
-      {
-        fried[size(fried)+1]=@j[@k];
-        @j[@k]=0;
-      }
-    }
-    if(size(fried)==nvars(basering))
-    {
-      setring @P;
-      primary[1]=i;
-      primary[2]=i;
-      return(primary);
-    }
-    if(size(fried)>0)
-    {
-      string newva;
-      string newma;
-      for(@k=1;@k<=nvars(basering);@k++)
-      {
-        @n1=0;
-        for(@n=1;@n<=size(fried);@n++)
-        {
-          if(leadmonom(fried[@n])==var(@k))
-          {
-            @n1=1;
-            break;
-          }
-        }
-        if(@n1==0)
-        {
-          newva=newva+string(var(@k))+",";
-          newma=newma+string(var(@k))+",";
-        }
-        else
-        {
-          newma=newma+string(0)+",";
-        }
-      }
-      newva[size(newva)]=")";
-      newma[size(newma)]=";";
-      execute("ring @deirf=("+charstr(gnir)+"),("+newva+",lp;");
-      execute("map @kappa=gnir,"+newma);
-      ideal @j= @kappa(@j);
-      @j=simplify(@j,2);
-      attrib(@j,"isSB",1);
-      list pr=decomp(@j);
-      setring gnir;
-      list pr=imap(@deirf,pr);
-      for(@k=1;@k<=size(pr);@k++)
-      {
-        @j=pr[@k]+fried;
-        pr[@k]=@j;
-      }
-      setring @P;
-      return(imap(gnir,pr));
-    }
-  }
-  //----------------------------------------------------------------
-  //j is the ring
-  //----------------------------------------------------------------
-
-  if (dim(@j)==-1)
-  {
-    setring @P;
-    primary=ideal(1),ideal(1);
-    return(primary);
-  }
-
-  //----------------------------------------------------------------
-  //  the case of one variable
-  //----------------------------------------------------------------
-
-  if(nvars(basering)==1)
-  {
-    list fac=factor(@j[1]);
-    list gprimary;
-    for(@k=1;@k<=size(fac[1]);@k++)
-    {
-      if(@wr==0)
-      {
-        gprimary[2*@k-1]=ideal(fac[1][@k]^fac[2][@k]);
-        gprimary[2*@k]=ideal(fac[1][@k]);
-      }
-      else
-      {
-        gprimary[2*@k-1]=ideal(fac[1][@k]);
-        gprimary[2*@k]=ideal(fac[1][@k]);
-      }
-    }
-    setring @P;
-    primary=fetch(gnir,gprimary);
-
-//HIER
-    if(abspri)
-    {
-      list resu,tempo;
-      string absotto;
-      for(ab=1;ab<=size(primary)/2;ab++)
-      {
-        absotto= absFactorize(primary[2*ab][1],77);
-        tempo=primary[2*ab-1],primary[2*ab],absotto,string(var(nvars(basering)));
-        resu[ab]=tempo;
-      }
-      primary=resu;
-    }
-    return(primary);
-  }
-
- //------------------------------------------------------------------
- //the zero-dimensional case
- //------------------------------------------------------------------
-  if (dim(@j)==0)
-  {
-    op=option(get);
-    option(redSB);
-    list gprimary= zero_decomp(@j,ser,@wr);
-
-    setring @P;
-    primary=fetch(gnir,gprimary);
-
-    if(size(ser)>0)
-    {
-      primary=cleanPrimary(primary);
-    }
-//HIER
-    if(abspri)
-    {
-      list resu,tempo;
-      string absotto;
-      for(ab=1;ab<=size(primary)/2;ab++)
-      {
-        absotto= absFactorize(primary[2*ab][1],77);
-        tempo=primary[2*ab-1],primary[2*ab],absotto,string(var(nvars(basering)));
-        resu[ab]=tempo;
-      }
-      primary=resu;
-    }
-    return(primary);
-  }
-
-  poly @gs,@gh,@p;
-  string @va,quotring;
-  list quprimary,htprimary,collectprimary,lsau,lnew,allindep,restindep;
-  ideal @h;
-  int jdim=dim(@j);
-  list fett;
-  int lauf,di,newtest;
-  //------------------------------------------------------------------
-  //search for a maximal independent set indep,i.e.
-  //look for subring such that the intersection with the ideal is zero
-  //j intersected with K[var(indep[3]+1),...,var(nvar] is zero,
-  //indep[1] is the new varstring and indep[2] the string for block-ordering
-  //------------------------------------------------------------------
-  if(@wr!=1)
-  {
-    allindep=independSet(@j);
-    for(@m=1;@m<=size(allindep);@m++)
-    {
-      if(allindep[@m][3]==jdim)
-      {
-        di++;
-        indep[di]=allindep[@m];
-      }
-      else
-      {
-        lauf++;
-        restindep[lauf]=allindep[@m];
-      }
-    }
-  }
-  else
-  {
-    indep=maxIndependSet(@j);
-  }
-
-  ideal jkeep=@j;
-  if(ordstr(@P)[1]=="w")
-  {
-    execute("ring @Phelp=("+charstr(gnir)+"),("+varstr(gnir)+"),("+ordstr(@P)+");");
-  }
-  else
-  {
-    execute( "ring @Phelp=("+charstr(gnir)+"),("+varstr(gnir)+"),(C,dp);");
-  }
-
-  if(homo==1)
-  {
-    if((ordstr(@P)[3]=="d")||(ordstr(@P)[1]=="d")||(ordstr(@P)[1]=="w")
-       ||(ordstr(@P)[3]=="w"))
-    {
-      ideal jwork=imap(@P,tras);
-      attrib(jwork,"isSB",1);
-    }
-    else
-    {
-      ideal jwork=std(imap(gnir,@j),@hilb,@w);
-    }
-  }
-  else
-  {
-    ideal jwork=groebner(imap(gnir,@j));
-  }
-  list hquprimary;
-  poly @p,@q;
-  ideal @h,fac,ser;
-  ideal @Ptest=1;
-  di=dim(jwork);
-  keepdi=di;
-
-  setring gnir;
-  for(@m=1;@m<=size(indep);@m++)
-  {
-    isat=0;
-    @n2=0;
-    if((indep[@m][1]==varstr(basering))&&(@m==1))
-    //this is the good case, nothing to do, just to have the same notations
-    //change the ring
-    {
-      execute("ring gnir1 = ("+charstr(basering)+"),("+varstr(basering)+"),("
-                             +ordstr(basering)+");");
-      ideal @j=fetch(gnir,@j);
-      attrib(@j,"isSB",1);
-      ideal ser=fetch(gnir,ser);
-    }
-    else
-    {
-      @va=string(maxideal(1));
-      if(@m==1)
-      {
-        @j=fetch(@P,i);
-      }
-      execute("ring gnir1 = ("+charstr(basering)+"),("+indep[@m][1]+"),("
-                              +indep[@m][2]+");");
-      execute("map phi=gnir,"+@va+";");
-      op=option(get);
-      option(redSB);
-      if(homo==1)
-      {
-        ideal @j=std(phi(@j),@hilb,@w);
-      }
-      else
-      {
-        ideal @j=groebner(phi(@j));
-      }
-      ideal ser=phi(ser);
-
-      option(set,op);
-    }
-    if((deg(@j[1])==0)||(dim(@j)<jdim))
-    {
-      setring gnir;
-      break;
-    }
-    for (lauf=1;lauf<=size(@j);lauf++)
-    {
-      fett[lauf]=size(@j[lauf]);
-    }
-    //------------------------------------------------------------------------
-    //we have now the following situation:
-    //j intersected with K[var(nnp+1),..,var(nva)] is zero so we may pass
-    //to this quotientring, j is their still a standardbasis, the
-    //leading coefficients of the polynomials  there (polynomials in
-    //K[var(nnp+1),..,var(nva)]) are collected in the list h,
-    //we need their ggt, gh, because of the following: let
-    //(j:gh^n)=(j:gh^infinity) then j*K(var(nnp+1),..,var(nva))[..the rest..]
-    //intersected with K[var(1),...,var(nva)] is (j:gh^n)
-    //on the other hand j=(j,gh^n) intersected with (j:gh^n)
-
-    //------------------------------------------------------------------------
-
-    //arrangement for quotientring K(var(nnp+1),..,var(nva))[..the rest..] and
-    //map phi:K[var(1),...,var(nva)] --->K(var(nnpr+1),..,var(nva))[..rest..]
-    //------------------------------------------------------------------------
-
-    quotring=prepareQuotientring(nvars(basering)-indep[@m][3]);
-
-    //---------------------------------------------------------------------
-    //we pass to the quotientring   K(var(nnp+1),..,var(nva))[..the rest..]
-    //---------------------------------------------------------------------
-
-    ideal @jj=lead(@j);               //!! vorn vereinbaren
-    execute(quotring);
-
-    ideal @jj=imap(gnir1,@jj);
-    @vv=clearSBNeu(@jj,fett);  //!! vorn vereinbaren
-    setring gnir1;
-    @k=size(@j);
-    for (lauf=1;lauf<=@k;lauf++)
-    {
-      if(@vv[lauf]==1)
-      {
-        @j[lauf]=0;
-      }
-    }
-    @j=simplify(@j,2);
-    setring quring;
-    // @j considered in the quotientring
-    ideal @j=imap(gnir1,@j);
-
-    ideal ser=imap(gnir1,ser);
-
-    kill gnir1;
-
-    //j is a standardbasis in the quotientring but usually not minimal
-    //here it becomes minimal
-
-    attrib(@j,"isSB",1);
-
-    //we need later ggt(h[1],...)=gh for saturation
-    ideal @h;
-    if(deg(@j[1])>0)
-    {
-      for(@n=1;@n<=size(@j);@n++)
-      {
-        @h[@n]=leadcoef(@j[@n]);
-      }
-      //the primary decomposition of j*K(var(nnp+1),..,var(nva))[..the rest..]
-      op=option(get);
-      option(redSB);
-
-      list uprimary= zero_decomp(@j,ser,@wr);
-//HIER
-      if(abspri)
-      {
-        ideal II;
-        ideal jmap;
-        map sigma;
-        nn=nvars(basering);
-        map invsigma=basering,maxideal(1);
-        for(ab=1;ab<=size(uprimary)/2;ab++)
-        {
-          II=uprimary[2*ab];
-          attrib(II,"isSB",1);
-          if(deg(II[1])!=vdim(II))
-          {
-            jmap=randomLast(50);
-            sigma=basering,jmap;
-            jmap[nn]=2*var(nn)-jmap[nn];
-            invsigma=basering,jmap;
-            II=groebner(sigma(II));
-          }
-          absprimarytmp[ab]= absFactorize(II[1],77);
-          II=var(nn);
-          abskeeptmp[ab]=string(invsigma(II));
-          invsigma=basering,maxideal(1);
-        }
-      }
-      option(set,op);
-    }
-    else
-    {
-      list uprimary;
-      uprimary[1]=ideal(1);
-      uprimary[2]=ideal(1);
-    }
-    //we need the intersection of the ideals in the list quprimary with the
-    //polynomialring, i.e. let q=(f1,...,fr) in the quotientring such an ideal
-    //but fi polynomials, then the intersection of q with the polynomialring
-    //is the saturation of the ideal generated by f1,...,fr with respect to
-    //h which is the lcm of the leading coefficients of the fi considered in
-    //in the quotientring: this is coded in saturn
-
-    list saturn;
-    ideal hpl;
-
-    for(@n=1;@n<=size(uprimary);@n++)
-    {
-      uprimary[@n]=interred(uprimary[@n]); // temporary fix
-      hpl=0;
-      for(@n1=1;@n1<=size(uprimary[@n]);@n1++)
-      {
-        hpl=hpl,leadcoef(uprimary[@n][@n1]);
-      }
-      saturn[@n]=hpl;
-    }
-
-    //--------------------------------------------------------------------
-    //we leave  the quotientring   K(var(nnp+1),..,var(nva))[..the rest..]
-    //back to the polynomialring
-    //---------------------------------------------------------------------
-    setring gnir;
-
-    collectprimary=imap(quring,uprimary);
-    lsau=imap(quring,saturn);
-    @h=imap(quring,@h);
-
-    kill quring;
-
-    @n2=size(quprimary);
-    @n3=@n2;
-
-    for(@n1=1;@n1<=size(collectprimary)/2;@n1++)
-    {
-      if(deg(collectprimary[2*@n1][1])>0)
-      {
-        @n2++;
-        quprimary[@n2]=collectprimary[2*@n1-1];
-        lnew[@n2]=lsau[2*@n1-1];
-        @n2++;
-        lnew[@n2]=lsau[2*@n1];
-        quprimary[@n2]=collectprimary[2*@n1];
-        if(abspri)
-        {
-          absprimary[@n2/2]=absprimarytmp[@n1];
-          abskeep[@n2/2]=abskeeptmp[@n1];
-        }
-      }
-    }
-    //here the intersection with the polynomialring
-    //mentioned above is really computed
-    for(@n=@n3/2+1;@n<=@n2/2;@n++)
-    {
-      if(specialIdealsEqual(quprimary[2*@n-1],quprimary[2*@n]))
-      {
-        quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
-        quprimary[2*@n]=quprimary[2*@n-1];
-      }
-      else
-      {
-        if(@wr==0)
-        {
-          quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
-        }
-        quprimary[2*@n]=sat2(quprimary[2*@n],lnew[2*@n])[1];
-      }
-    }
-
-    if(size(@h)>0)
-    {
-      //---------------------------------------------------------------
-      //we change to @Phelp to have the ordering dp for saturation
-      //---------------------------------------------------------------
-      setring @Phelp;
-      @h=imap(gnir,@h);
-      if(@wr!=1)
-      {
-        if(defined(@LL)){kill @LL;}
-        list @LL=minSat(jwork,@h);
-        @Ptest=intersect(@Ptest,@LL[1]);
-        @q=@LL[2];
-      }
-      else
-      {
-        fac=ideal(0);
-        for(lauf=1;lauf<=ncols(@h);lauf++)
-        {
-          if(deg(@h[lauf])>0)
-          {
-            fac=fac+factorize(@h[lauf],1);
-          }
-        }
-        fac=simplify(fac,6);
-        @q=1;
-        for(lauf=1;lauf<=size(fac);lauf++)
-        {
-          @q=@q*fac[lauf];
-        }
-      }
-      jwork=std(jwork,@q);
-      keepdi=dim(jwork);
-      if(keepdi<di)
-      {
-        setring gnir;
-        @j=imap(@Phelp,jwork);
-        break;
-      }
-      if(homo==1)
-      {
-        @hilb=hilb(jwork,1,@w);
-      }
-
-      setring gnir;
-      @j=imap(@Phelp,jwork);
-    }
-  }
-
-  if((size(quprimary)==0)&&(@wr==1))
-  {
-    @j=ideal(1);
-    quprimary[1]=ideal(1);
-    quprimary[2]=ideal(1);
-  }
-  if((size(quprimary)==0))
-  {
-    keepdi=di-1;
-    quprimary[1]=ideal(1);
-    quprimary[2]=ideal(1);
-  }
-  //---------------------------------------------------------------
-  //notice that j=sat(j,gh) intersected with (j,gh^n)
-  //we finished with sat(j,gh) and have to start with (j,gh^n)
-  //---------------------------------------------------------------
-  if((deg(@j[1])!=0)&&(@wr!=1))
-  {
-    if(size(quprimary)>0)
-    {
-      setring @Phelp;
-      ser=imap(gnir,ser);
-      hquprimary=imap(gnir,quprimary);
-      if(@wr==0)
-      {
-        //HIER STATT DURCHSCHNITT SATURIEREN!
-        ideal htest=@Ptest;
-      }
-      else
-      {
-        ideal htest=hquprimary[2];
-
-        for (@n1=2;@n1<=size(hquprimary)/2;@n1++)
-        {
-          htest=intersect(htest,hquprimary[2*@n1]);
-        }
-      }
-
-      if(size(ser)>0)
-      {
-        ser=intersect(htest,ser);
-      }
-      else
-      {
-        ser=htest;
-      }
-      setring gnir;
-      ser=imap(@Phelp,ser);
-    }
-    if(size(reduce(ser,peek,1))!=0)
-    {
-      for(@m=1;@m<=size(restindep);@m++)
-      {
-        // if(restindep[@m][3]>=keepdi)
-        // {
-        isat=0;
-        @n2=0;
-
-        if(restindep[@m][1]==varstr(basering))
-        //the good case, nothing to do, just to have the same notations
-        //change the ring
-        {
-          execute("ring gnir1 = ("+charstr(basering)+"),("+
-             varstr(basering)+"),("+ordstr(basering)+");");
-          ideal @j=fetch(gnir,jkeep);
-          attrib(@j,"isSB",1);
-        }
-        else
-        {
-          @va=string(maxideal(1));
-          execute("ring gnir1 = ("+charstr(basering)+"),("+
-                    restindep[@m][1]+"),(" +restindep[@m][2]+");");
-          execute("map phi=gnir,"+@va+";");
-          op=option(get);
-          option(redSB);
-          if(homo==1)
-          {
-            ideal @j=std(phi(jkeep),keephilb,@w);
-          }
-          else
-          {
-            ideal @j=groebner(phi(jkeep));
-          }
-          ideal ser=phi(ser);
-          option(set,op);
-        }
-
-        for (lauf=1;lauf<=size(@j);lauf++)
-        {
-          fett[lauf]=size(@j[lauf]);
-        }
-        //------------------------------------------------------------------
-        //we have now the following situation:
-        //j intersected with K[var(nnp+1),..,var(nva)] is zero so we may
-        //pass to this quotientring, j is their still a standardbasis, the
-        //leading coefficients of the polynomials  there (polynomials in
-        //K[var(nnp+1),..,var(nva)]) are collected in the list h,
-        //we need their ggt, gh, because of the following:
-        //let (j:gh^n)=(j:gh^infinity) then
-        //j*K(var(nnp+1),..,var(nva))[..the rest..]
-        //intersected with K[var(1),...,var(nva)] is (j:gh^n)
-        //on the other hand j=(j,gh^n) intersected with (j:gh^n)
-
-        //------------------------------------------------------------------
-
-        //the arrangement for the quotientring
-        // K(var(nnp+1),..,var(nva))[..the rest..]
-        //and the map phi:K[var(1),...,var(nva)] ---->
-        //--->K(var(nnpr+1),..,var(nva))[..the rest..]
-        //------------------------------------------------------------------
-
-        quotring=prepareQuotientring(nvars(basering)-restindep[@m][3]);
-
-        //------------------------------------------------------------------
-        //we pass to the quotientring  K(var(nnp+1),..,var(nva))[..rest..]
-        //------------------------------------------------------------------
-
-        execute(quotring);
-
-        // @j considered in the quotientring
-        ideal @j=imap(gnir1,@j);
-        ideal ser=imap(gnir1,ser);
-
-        kill gnir1;
-
-        //j is a standardbasis in the quotientring but usually not minimal
-        //here it becomes minimal
-        @j=clearSB(@j,fett);
-        attrib(@j,"isSB",1);
-
-        //we need later ggt(h[1],...)=gh for saturation
-        ideal @h;
-
-        for(@n=1;@n<=size(@j);@n++)
-        {
-          @h[@n]=leadcoef(@j[@n]);
-        }
-        //the primary decomposition of j*K(var(nnp+1),..,var(nva))[..rest..]
-
-        op=option(get);
-        option(redSB);
-        list uprimary= zero_decomp(@j,ser,@wr);
-//HIER
-        if(abspri)
-        {
-          ideal II;
-          ideal jmap;
-          map sigma;
-          nn=nvars(basering);
-          map invsigma=basering,maxideal(1);
-          for(ab=1;ab<=size(uprimary)/2;ab++)
-          {
-            II=uprimary[2*ab];
-            attrib(II,"isSB",1);
-            if(deg(II[1])!=vdim(II))
-            {
-              jmap=randomLast(50);
-              sigma=basering,jmap;
-              jmap[nn]=2*var(nn)-jmap[nn];
-              invsigma=basering,jmap;
-              II=groebner(sigma(II));
-            }
-            absprimarytmp[ab]= absFactorize(II[1],77);
-            II=var(nn);
-            abskeeptmp[ab]=string(invsigma(II));
-            invsigma=basering,maxideal(1);
-          }
-        }
-        option(set,op);
-
-        //we need the intersection of the ideals in the list quprimary with
-        //the polynomialring, i.e. let q=(f1,...,fr) in the quotientring
-        //such an ideal but fi polynomials, then the intersection of q with
-        //the polynomialring is the saturation of the ideal generated by
-        //f1,...,fr with respect toh which is the lcm of the leading
-        //coefficients of the fi considered in the quotientring:
-        //this is coded in saturn
-
-        list saturn;
-        ideal hpl;
-
-        for(@n=1;@n<=size(uprimary);@n++)
-        {
-          hpl=0;
-          for(@n1=1;@n1<=size(uprimary[@n]);@n1++)
-          {
-            hpl=hpl,leadcoef(uprimary[@n][@n1]);
-          }
-          saturn[@n]=hpl;
-        }
-        //------------------------------------------------------------------
-        //we leave  the quotientring   K(var(nnp+1),..,var(nva))[..rest..]
-        //back to the polynomialring
-        //------------------------------------------------------------------
-        setring gnir;
-        collectprimary=imap(quring,uprimary);
-        lsau=imap(quring,saturn);
-        @h=imap(quring,@h);
-
-        kill quring;
-
-
-        @n2=size(quprimary);
-        @n3=@n2;
-
-        for(@n1=1;@n1<=size(collectprimary)/2;@n1++)
-        {
-          if(deg(collectprimary[2*@n1][1])>0)
-          {
-            @n2++;
-            quprimary[@n2]=collectprimary[2*@n1-1];
-            lnew[@n2]=lsau[2*@n1-1];
-            @n2++;
-            lnew[@n2]=lsau[2*@n1];
-            quprimary[@n2]=collectprimary[2*@n1];
-            if(abspri)
-            {
-              absprimary[@n2/2]=absprimarytmp[@n1];
-              abskeep[@n2/2]=abskeeptmp[@n1];
-            }
-          }
-        }
-
-        //here the intersection with the polynomialring
-        //mentioned above is really computed
-
-        for(@n=@n3/2+1;@n<=@n2/2;@n++)
-        {
-          if(specialIdealsEqual(quprimary[2*@n-1],quprimary[2*@n]))
-          {
-            quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
-            quprimary[2*@n]=quprimary[2*@n-1];
-          }
-          else
-          {
-            if(@wr==0)
-            {
-              quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
-            }
-            quprimary[2*@n]=sat2(quprimary[2*@n],lnew[2*@n])[1];
-          }
-        }
-        if(@n2>=@n3+2)
-        {
-          setring @Phelp;
-          ser=imap(gnir,ser);
-          hquprimary=imap(gnir,quprimary);
-          for(@n=@n3/2+1;@n<=@n2/2;@n++)
-          {
-            if(@wr==0)
-            {
-              ser=intersect(ser,hquprimary[2*@n-1]);
-            }
-            else
-            {
-              ser=intersect(ser,hquprimary[2*@n]);
-            }
-          }
-          setring gnir;
-          ser=imap(@Phelp,ser);
-        }
-
-         // }
-      }
-//HIER
-      if(abspri)
-      {
-        list resu,tempo;
-        for(ab=1;ab<=size(quprimary)/2;ab++)
-        {
-          if (deg(quprimary[2*ab][1])!=0)
-          {
-            tempo=quprimary[2*ab-1],quprimary[2*ab],
-                         absprimary[ab],abskeep[ab];
-            resu[ab]=tempo;
-          }
-        }
-        quprimary=resu;
-        @wr=3;
-      }
-      if(size(reduce(ser,peek,1))!=0)
-      {
-        if(@wr>0)
-        {
-          htprimary=decomp(@j,@wr,peek,ser);
-        }
-        else
-        {
-          htprimary=decomp(@j,peek,ser);
-        }
-        // here we collect now both results primary(sat(j,gh))
-        // and primary(j,gh^n)
-        @n=size(quprimary);
-        for (@k=1;@k<=size(htprimary);@k++)
-        {
-          quprimary[@n+@k]=htprimary[@k];
-        }
-      }
-    }
-  }
-  else
-  {
-    if(abspri)
-    {
-      list resu,tempo;
-      for(ab=1;ab<=size(quprimary)/2;ab++)
-      {
-        tempo=quprimary[2*ab-1],quprimary[2*ab],
-                 absprimary[ab],abskeep[ab];
-        resu[ab]=tempo;
-      }
-      quprimary=resu;
-    }
-  }
-  //---------------------------------------------------------------------------
-  //back to the ring we started with
-  //the final result: primary
-  //---------------------------------------------------------------------------
-
-  setring @P;
-  primary=imap(gnir,quprimary);
-  if(!abspri)
-  {
-    primary=cleanPrimary(primary);
-  }
-  return(primary);
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring  r = 32003,(x,y,z),lp;
-   poly  p = z2+1;
-   poly  q = z4+2;
-   ideal i = p^2*q^3,(y-z3)^3,(x-yz+z4)^4;
-   list pr= decomp(i);
-   pr;
-   testPrimary( pr, i);
-}
-
-///////////////////////////////////////////////////////////////////////////////
-static proc powerCoeffs(poly f,int e)
-//computes a polynomial with the same monomials as f but coefficients
-//the p^e th power of the coefficients of f
-{
-  int i;
-  poly g;
-  int ex=char(basering)^e;
-  for(i=1;i<=size(f);i++)
-  {
-    g=g+leadcoef(f[i])^ex*leadmonom(f[i]);
-  }
-  return(g);
-}
-///////////////////////////////////////////////////////////////////////////////
-
-proc sep(poly f,int i, list #)
-"USAGE:  input: a polynomial f depending on the i-th variable and optional
-         an integer k considering the polynomial f defined over Fp(t1,...,tm)
-         as polynomial over Fp(t(1)^(p^-k),...,t(m)^(p^-k))
- RETURN: the separabel part of f as polynomial in Fp(t1,...,tm)
-        and an integer k to indicate that f should be considerd
-        as polynomial over Fp(t(1)^(p^-k),...,t(m)^(p^-k))
- EXAMPLE: example sep; shows an example
-{
-  def R=basering;
-  int k;
-  if(size(#)>0){k=#[1];}
-
-  poly h=gcd(f,diff(f,var(i)));
-  if((reduce(f,std(h))!=0)||(reduce(diff(f,var(i)),std(h))!=0))
-  {
-    ERROR("FEHLER IN GCD");
-  }
-  poly g1=lift(h,f)[1][1];    //  f/h
-  poly h1;
-
-  while(h!=h1)
-  {
-    h1=h;
-    h=gcd(h,diff(h,var(i)));
-  }
-
-  if(deg(h1)==0){return(list(g1,k));} //in characteristic 0 we return here
-
-  k++;
-
-  ideal ma=maxideal(1);
-  ma[i]=var(i)^char(R);
-  map phi=R,ma;
-  ideal hh=h;    //this is technical because preimage works only for ideals
-
-  poly u=preimage(R,phi,hh)[1]; //h=u(x(i)^p)
-
-  list g2=sep(u,i,k);           //we consider u(t(1)^(p^-1),...,t(m)^(p^-1))
-  g1=powerCoeffs(g1,g2[2]-k+1); //to have g1 over the same field as g2[1]
-
-  list g3=sep(g1*g2[1],i,g2[2]);
-  return(g3);
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring R=(5,t,s),(x,y,z),dp;
-   poly f=(x^25-t*x^5+t)*(x^3+s);
-   sep(f,1);
-}
-
-///////////////////////////////////////////////////////////////////////////////
- proc zeroRad(ideal I,list #)
-"USAGE:  zeroRad(I) , I a zero-dimensional ideal
- RETURN: the radical of I
- NOTE:  Algorithm of Kemper
- EXAMPLE: example zeroRad; shows an example
-{
-  if(homog(I)==1){return(maxideal(1));}
-  //I needs to be a reduced standard basis
-  def R=basering;
-  int m=npars(R);
-  int n=nvars(R);
-  int p=char(R);
-  int d=vdim(I);
-  int i,k;
-  list l;
-  if(((p==0)||(p>d))&&(d==deg(I[1])))
-  {
-    intvec e=leadexp(I[1]);
-    for(i=1;i<=nvars(basering);i++)
-    {
-     if(e[i]!=0) break;
-    }
-    I[1]=sep(I[1],i)[1];
-    return(interred(I));
-  }
-  intvec op=option(get);
-
-  option(redSB);
-  ideal F=finduni(I);//F[i] generates I intersected with K[var(i)]
-
-  option(set,op);
-  if(size(#)>0){I=#[1];}
-
-  for(i=1;i<=n;i++)
-  {
-    l[i]=sep(F[i],i);
-    F[i]=l[i][1];
-    if(l[i][2]>k){k=l[i][2];}  //computation of the maximal k
-  }
-
-  if((k==0)||(m==0)){return(interred(I+F));}        //the separable case
-
-  for(i=1;i<=n;i++)             //consider all polynomials over
-  {                             //Fp(t(1)^(p^-k),...,t(m)^(p^-k))
-    F[i]=powerCoeffs(F[i],k-l[i][2]);
-  }
-
-  string cR="ring @R="+string(p)+",("+parstr(R)+","+varstr(R)+"),dp;";
-  execute(cR);
-  ideal F=imap(R,F);
-
-  string nR="ring @S="+string(p)+",(y(1..m),"+varstr(R)+","+parstr(R)+"),dp;";
-  execute(nR);
-
-  ideal G=fetch(@R,F);    //G[i](t(1)^(p^-k),...,t(m)^(p^-k),x(i))=sep(F[i])
-
-  ideal I=imap(R,I);
-  ideal J=I+G;
-  poly el=1;
-  k=p^k;
-  for(i=1;i<=m;i++)
-  {
-    J=J,var(i)^k-var(m+n+i);
-    el=el*y(i);
-  }
-
-  J=eliminate(J,el);
-  setring R;
-  ideal J=imap(@S,J);
-  return(J);
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring R=(5,t),(x,y),dp;
-   ideal I=x^5-t,y^5-t;
-   zeroRad(I);
-}
-
-///////////////////////////////////////////////////////////////////////////////
-
-proc radicalEHV(ideal i)
-"USAGE:   radicalEHV(i); i ideal.
-RETURN:  ideal, the radical of i.
-NOTE:    Uses the algorithm of Eisenbud/Huneke/Vasconcelos, which
-         reduces the computation to the complete intersection case,
-         by taking, in the general case, a generic linear combination
-         of the input.
-         Works only in characteristic 0 or p large.
-EXAMPLE: example radicalEHV; shows an example
-"
-{
-  if(attrib(basering,"global")!=1)
-  {
-    ERROR(
-      "// Not implemented for this ordering, please change to global ordering."
-    );
-  }
-  if((char(basering)<100)&&(char(basering)!=0))
-  {
-    "WARNING: The characteristic is too small, the result may be wrong";
-  }
-  ideal J,I,I0,radI0,L,radI1,I2,radI2;
-  int l,n;
-  intvec op=option(get);
-  matrix M;
-
-  option(redSB);
-  list m=mstd(i);
-  I=m[2];
-  option(set,op);
-
-  int cod=nvars(basering)-dim(m[1]);
-  //-------------------complete intersection case:----------------------
-  if(cod==size(m[2]))
-  {
-    J=minor(jacob(I),cod);
-    return(quotient(I,J));
-  }
-  //-----first codim elements of I are a complete intersection:---------
-  for(l=1;l<=cod;l++)
-  {
-    I0[l]=I[l];
-  }
-  n=dim(std(I0))+cod-nvars(basering);
-  //-----last codim elements of I are a complete intersection:----------
-  if(n!=0)
-  {
-    for(l=1;l<=cod;l++)
-    {
-      I0[l]=I[size(I)-l+1];
-    }
-    n=dim(std(I0))+cod-nvars(basering);
-  }
-  //-----taking a generic linear combination of the input:--------------
-  if(n!=0)
-  {
-    M=transpose(sparsetriag(size(m[2]),cod,95,1));
-    I0=ideal(M*transpose(I));
-    n=dim(std(I0))+cod-nvars(basering);
-  }
-  //-----taking a more generic linear combination of the input:---------
-  if(n!=0)
-  {
-    M=transpose(sparsetriag(size(m[2]),cod,0,100));
-    I0=ideal(M*transpose(I));
-    n=dim(std(I0))+cod-nvars(basering);
-  }
-  if(n==0)
-  {
-    J=minor(jacob(I0),cod);
-    radI0=quotient(I0,J);
-    L=quotient(radI0,I);
-    radI1=quotient(radI0,L);
-
-    if(size(reduce(radI1,m[1],1))==0)
-    {
-      return(I);
-    }
-
-    I2=sat(I,radI1)[1];
-
-    if(deg(I2[1])<=0)
-    {
-      return(radI1);
-    }
-    return(intersect(radI1,radicalEHV(I2)));
-  }
-  //---------------------general case-------------------------------------
-  return(radical(I));
-}
-example
-{ "EXAMPLE:";  echo = 2;
-   ring  r = 0,(x,y,z),dp;
-   poly  p = z2+1;
-   poly  q = z3+2;
-   ideal i = p*q^2,y-z2;
-   ideal pr= radicalEHV(i);
-   pr;
-}
-
-///////////////////////////////////////////////////////////////////////////////
-
-proc Ann(module M)
-"USAGE:   Ann(M);  M module
-RETURN:  ideal, the annihilator of coker(M)
-NOTE:    The output is the ideal of all elements a of the basering R such that
-         a * R^m is contained in M  (m=number of rows of M).
-EXAMPLE: example Ann; shows an example
-"
-{
-  M=prune(M);  //to obtain a small embedding
-  ideal ann=quotient1(M,freemodule(nrows(M)));
-  return(ann);
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring  r = 0,(x,y,z),lp;
-   module M = x2-y2,z3;
-   Ann(M);
-   M = [1,x2],[y,x];
-   Ann(M);
-   qring Q=std(xy-1);
-   module M=imap(r,M);
-   Ann(M);
-}
-
-///////////////////////////////////////////////////////////////////////////////
-
-//computes the equidimensional part of the ideal i of codimension e
-static proc int_ass_primary_e(ideal i, int e)
-{
-  if(homog(i)!=1)
-  {
-    i=std(i);
-  }
-  list re=sres(i,0);                   //the resolution
-  re=minres(re);                       //minimized resolution
-  ideal ann=AnnExt_R(e,re);
-  if(nvars(basering)-dim(std(ann))!=e)
-  {
-    return(ideal(1));
-  }
-  return(ann);
-}
-
-///////////////////////////////////////////////////////////////////////////////
-
-//computes the annihilator of Ext^n(R/i,R) with given resolution re
-//n is not necessarily the number of variables
-static proc AnnExt_R(int n,list re)
-{
-  if(n<nvars(basering))
-  {
-    matrix f=transpose(re[n+1]);      //Hom(_,R)
-    module k=nres(f,2)[2];            //the kernel
-    matrix g=transpose(re[n]);        //the image of Hom(_,R)
-
-    ideal ann=quotient1(g,k);           //the anihilator
-  }
-  else
-  {
-    ideal ann=Ann(transpose(re[n]));
-  }
-  return(ann);
-}
-///////////////////////////////////////////////////////////////////////////////
-
-static proc analyze(list pr)
-{
-  int ii,jj;
-  for(ii=1;ii<=size(pr)/2;ii++)
-  {
-    dim(std(pr[2*ii]));
-    idealsEqual(pr[2*ii-1],pr[2*ii]);
-    "===========================";
-  }
-
-  for(ii=size(pr)/2;ii>1;ii--)
-  {
-    for(jj=1;jj<ii;jj++)
-    {
-      if(size(reduce(pr[2*jj],std(pr[2*ii],1)))==0)
-      {
-        "eingebette Komponente";
-        jj;
-        ii;
-      }
-    }
-  }
-}
-
-///////////////////////////////////////////////////////////////////////////////
-//
-//                  Shimoyama-Yokoyama
-//
-///////////////////////////////////////////////////////////////////////////////
-
-static proc simplifyIdeal(ideal i)
-{
-  def r=basering;
-
-  int j,k;
-  map phi;
-  poly p;
-
-  ideal iwork=i;
-  ideal imap1=maxideal(1);
-  ideal imap2=maxideal(1);
-
-
-  for(j=1;j<=nvars(basering);j++)
-  {
-    for(k=1;k<=ncols(i);k++)
-    {
-      if(deg(iwork[k]/var(j))==0)
-      {
-        p=-1/leadcoef(iwork[k]/var(j))*iwork[k];
-        imap1[j]=p+2*var(j);
-        phi=r,imap1;
-        iwork=phi(iwork);
-        iwork=subst(iwork,var(j),0);
-        iwork[k]=var(j);
-        imap1=maxideal(1);
-        imap2[j]=-p;
-        break;
-      }
-    }
-  }
-  return(iwork,imap2);
-}
-
-
-///////////////////////////////////////////////////////
-// ini_mod
-// input: a polynomial p
-// output: the initial term of p as needed
-// in the context of characteristic sets
-//////////////////////////////////////////////////////
-
-static proc ini_mod(poly p)
-{
-  if (p==0)
-  {
-    return(0);
-  }
-  int n; matrix m;
-  for( n=nvars(basering); n>0; n--)
-  {
-    m=coef(p,var(n));
-    if(m[1,1]!=1)
-    {
-      p=m[2,1];
-      break;
-    }
-  }
-  if(deg(p)==0)
-  {
-    p=0;
-  }
-  return(p);
-}
-///////////////////////////////////////////////////////
-// min_ass_prim_charsets
-// input: generators of an ideal PS and an integer cho
-// If cho=0, the given ordering of the variables is used.
-// Otherwise, the system tries to find an "optimal ordering",
-// which in some cases may considerably speed up the algorithm
-// output: the minimal associated primes of PS
-// algorithm: via characteriostic sets
-//////////////////////////////////////////////////////
-
-
-static proc min_ass_prim_charsets (ideal PS, int cho)
-{
-  if((cho<0) and (cho>1))
-  {
-    ERROR(" <int> must be 0 or 1");
-  }
-  option(notWarnSB);
-  if(cho==0)
-  {
-    return(min_ass_prim_charsets0(PS));
-  }
-  else
-  {
-    return(min_ass_prim_charsets1(PS));
-  }
-}
-///////////////////////////////////////////////////////
-// min_ass_prim_charsets0
-// input: generators of an ideal PS
-// output: the minimal associated primes of PS
-// algorithm: via characteristic sets
-// the given ordering of the variables is used
-//////////////////////////////////////////////////////
-
-
-static proc min_ass_prim_charsets0 (ideal PS)
-{
-  intvec op;
-  matrix m=char_series(PS);  // We compute an irreducible
-                             // characteristic series
-  int i,j,k;
-  list PSI;
-  list PHI;  // the ideals given by the characteristic series
-  for(i=nrows(m);i>=1; i--)
-  {
-    PHI[i]=ideal(m[i,1..ncols(m)]);
-  }
-  // We compute the radical of each ideal in PHI
-  ideal I,JS,II;
-  int sizeJS, sizeII;
-  for(i=size(PHI);i>=1; i--)
-  {
-    I=0;
-    for(j=size(PHI[i]);j>0;j--)
-    {
-      I=I+ini_mod(PHI[i][j]);
-    }
-    JS=std(PHI[i]);
-    sizeJS=ncols(JS);
-    for(j=ncols(I);j>0;j--)
-    {
-      II=0;
-      sizeII=0;
-      k=0;
-      while(k<=sizeII)                  // successive saturation
-      {
-        op=option(get);
-        option(returnSB);
-        II=quotient(JS,I[j]);
-        option(set,op);
-        sizeII=ncols(II);
-        if(sizeII==sizeJS)
-        {
-          for(k=1;k<=sizeII;k++)
-          {
-            if(leadexp(II[k])!=leadexp(JS[k])) break;
-          }
-        }
-        JS=II;
-        sizeJS=sizeII;
-      }
-    }
-    PSI=insert(PSI,JS);
-  }
-  int sizePSI=size(PSI);
-  // We eliminate redundant ideals
-  for(i=1;i<sizePSI;i++)
-  {
-    for(j=i+1;j<=sizePSI;j++)
-    {
-      if(size(PSI[i])!=0)
-      {
-        if(size(PSI[j])!=0)
-        {
-          if(size(NF(PSI[i],PSI[j],1))==0)
-          {
-            PSI[j]=ideal(0);
-          }
-          else
-          {
-            if(size(NF(PSI[j],PSI[i],1))==0)
-            {
-              PSI[i]=ideal(0);
-            }
-          }
-        }
-      }
-    }
-  }
-  for(i=sizePSI;i>=1;i--)
-  {
-    if(size(PSI[i])==0)
-    {
-      PSI=delete(PSI,i);
-    }
-  }
-  return (PSI);
-}
-
-///////////////////////////////////////////////////////
-// min_ass_prim_charsets1
-// input: generators of an ideal PS
-// output: the minimal associated primes of PS
-// algorithm: via characteristic sets
-// input: generators of an ideal PS and an integer i
-// The system tries to find an "optimal ordering" of
-// the variables
-//////////////////////////////////////////////////////
-
-
-static proc min_ass_prim_charsets1 (ideal PS)
-{
-  intvec op;
-  def oldring=basering;
-  string n=system("neworder",PS);
-  execute("ring r=("+charstr(oldring)+"),("+n+"),dp;");
-  ideal PS=imap(oldring,PS);
-  matrix m=char_series(PS);  // We compute an irreducible
-                             // characteristic series
-  int i,j,k;
-  ideal I;
-  list PSI;
-  list PHI;    // the ideals given by the characteristic series
-  list ITPHI;  // their initial terms
-  for(i=nrows(m);i>=1; i--)
-  {
-    PHI[i]=ideal(m[i,1..ncols(m)]);
-    I=0;
-    for(j=size(PHI[i]);j>0;j=j-1)
-    {
-      I=I,ini_mod(PHI[i][j]);
-    }
-    I=I[2..ncols(I)];
-    ITPHI[i]=I;
-  }
-  setring oldring;
-  matrix m=imap(r,m);
-  list PHI=imap(r,PHI);
-  list ITPHI=imap(r,ITPHI);
-  // We compute the radical of each ideal in PHI
-  ideal I,JS,II;
-  int sizeJS, sizeII;
-  for(i=size(PHI);i>=1; i--)
-  {
-    I=0;
-    for(j=size(PHI[i]);j>0;j--)
-    {
-      I=I+ITPHI[i][j];
-    }
-    JS=std(PHI[i]);
-    sizeJS=size(JS);
-    for(j=ncols(I);j>0;j--)
-    {
-      II=0;
-      sizeII=0;
-      k=0;
-      while(k<=sizeII)                  // successive iteration
-      {
-        op=option(get);
-        option(returnSB);
-        II=quotient(JS,I[j]);
-        option(set,op);
-//std
-//        II=std(II);
-        sizeII=ncols(II);
-        if(sizeII==sizeJS)
-        {
-          for(k=1;k<=sizeII;k++)
-          {
-            if(leadexp(II[k])!=leadexp(JS[k])) break;
-          }
-        }
-        JS=II;
-        sizeJS=sizeII;
-      }
-    }
-    PSI=insert(PSI,JS);
-  }
-  int sizePSI=size(PSI);
-  // We eliminate redundant ideals
-  for(i=1;i<sizePSI;i++)
-  {
-    for(j=i+1;j<=sizePSI;j++)
-    {
-      if(size(PSI[i])!=0)
-      {
-        if(size(PSI[j])!=0)
-        {
-          if(size(NF(PSI[i],PSI[j],1))==0)
-          {
-            PSI[j]=ideal(0);
-          }
-          else
-          {
-            if(size(NF(PSI[j],PSI[i],1))==0)
-            {
-              PSI[i]=ideal(0);
-            }
-          }
-        }
-      }
-    }
-  }
-  for(i=sizePSI;i>=1;i--)
-  {
-    if(size(PSI[i])==0)
-    {
-      PSI=delete(PSI,i);
-    }
-  }
-  return (PSI);
-}
-
-
-/////////////////////////////////////////////////////
-// proc prim_dec
-// input:  generators of an ideal I and an integer choose
-// If choose=0, min_ass_prim_charsets with the given
-// ordering of the variables is used.
-// If choose=1, min_ass_prim_charsets with the "optimized"
-// ordering of the variables is used.
-// If choose=2, minAssPrimes from primdec.lib is used
-// If choose=3, minAssPrimes+factorizing Buchberger from primdec.lib is used
-// output: a primary decomposition of I, i.e., a list
-// of pairs consisting of a standard basis of a primary component
-// of I and a standard basis of the corresponding associated prime.
-// To compute the minimal associated primes of a given ideal
-// min_ass_prim_l is called, i.e., the minimal associated primes
-// are computed via characteristic sets.
-// In the homogeneous case, the performance of the procedure
-// will be improved if I is already given by a minimal set of
-// generators. Apply minbase if necessary.
-//////////////////////////////////////////////////////////
-
-
-static proc prim_dec(ideal I, int choose)
-{
-  if((choose<0) or (choose>3))
-  {
-    ERROR("ERROR: <int> must be 0 or 1 or 2 or 3");
-  }
-  option(notWarnSB);
-  ideal H=1; // The intersection of the primary components
-  list U;    // the leaves of the decomposition tree, i.e.,
-             // pairs consisting of a primary component of I
-             // and the corresponding associated prime
-  list W;    // the non-leaf vertices in the decomposition tree.
-             // every entry has 6 components:
-                // 1- the vertex itself , i.e., a standard bais of the
-                //    given ideal I (type 1), or a standard basis of a
-                //    pseudo-primary component arising from
-                //    pseudo-primary decomposition (type 2), or a
-                //    standard basis of a remaining component arising from
-                //    pseudo-primary decomposition or extraction (type 3)
-                // 2- the type of the vertex as indicated above
-                // 3- the weighted_tree_depth of the vertex
-                // 4- the tester of the vertex
-                // 5- a standard basis of the associated prime
-                //    of a vertex of type 2, or 0 otherwise
-                // 6- a list of pairs consisting of a standard
-                //    basis of a minimal associated prime ideal
-                //    of the father of the vertex and the
-                //    irreducible factors of the "minimal
-                //    divisor" of the seperator or extractor
-                //    corresponding to the prime ideal
-                //    as computed by the procedure minsat,
-                //    if the vertex is of type 3, or
-                //    the empty list otherwise
-  ideal SI=std(I);
-  if(SI[1]==1)  // primdecSY(ideal(1))
-  {
-    return(list());
-  }
-  int ncolsSI=ncols(SI);
-  int ncolsH=1;
-  W[1]=list(I,1,0,poly(1),ideal(0),list()); // The root of the tree
-  int weighted_tree_depth;
-  int i,j;
-  int check;
-  list V;  // current vertex
-  list VV; // new vertex
-  list QQ;
-  list WI;
-  ideal Qi,SQ,SRest,fac;
-  poly tester;
-
-  while(1)
-  {
-    i=1;
-    while(1)
-    {
-      while(i<=size(W)) // find vertex V of smallest weighted tree-depth
-      {
-        if (W[i][3]<=weighted_tree_depth) break;
-        i++;
-      }
-      if (i<=size(W)) break;
-      i=1;
-      weighted_tree_depth++;
-    }
-    V=W[i];
-    W=delete(W,i); // delete V from W
-
-    // now proceed by type of vertex V
-
-    if (V[2]==2)  // extraction needed
-    {
-      SQ,SRest,fac=extraction(V[1],V[5]);
-                        // standard basis of primary component,
-                        // standard basis of remaining component,
-                        // irreducible factors of
-                        // the "minimal divisor" of the extractor
-                        // as computed by the procedure minsat,
-      check=0;
-      for(j=1;j<=ncolsH;j++)
-      {
-        if (NF(H[j],SQ,1)!=0) // Q is not redundant
-        {
-          check=1;
-          break;
-        }
-      }
-      if(check==1)             // Q is not redundant
-      {
-        QQ=list();
-        QQ[1]=list(SQ,V[5]);  // primary component, associated prime,
-                              // i.e., standard bases thereof
-        U=U+QQ;
-        H=intersect(H,SQ);
-        H=std(H);
-        ncolsH=ncols(H);
-        check=0;
-        if(ncolsH==ncolsSI)
-        {
-          for(j=1;j<=ncolsSI;j++)
-          {
-            if(leadexp(H[j])!=leadexp(SI[j]))
-            {
-              check=1;
-              break;
-            }
-          }
-        }
-        else
-        {
-          check=1;
-        }
-        if(check==0) // H==I => U is a primary decomposition
-        {
-          return(U);
-        }
-      }
-      if (SRest[1]!=1)        // the remaining component is not
-                              // the whole ring
-      {
-        if (rad_con(V[4],SRest)==0) // the new vertex is not the
-                                    // root of a redundant subtree
-        {
-          VV[1]=SRest;     // remaining component
-          VV[2]=3;         // pseudoprimdec_special
-          VV[3]=V[3]+1;    // weighted depth
-          VV[4]=V[4];      // the tester did not change
-          VV[5]=ideal(0);
-          VV[6]=list(list(V[5],fac));
-          W=insert(W,VV,size(W));
-        }
-      }
-    }
-    else
-    {
-      if (V[2]==3) // pseudo_prim_dec_special is needed
-      {
-        QQ,SRest=pseudo_prim_dec_special_charsets(V[1],V[6],choose);
-                         // QQ = quadruples:
-                         // standard basis of pseudo-primary component,
-                         // standard basis of corresponding prime,
-                         // seperator, irreducible factors of
-                         // the "minimal divisor" of the seperator
-                         // as computed by the procedure minsat,
-                         // SRest=standard basis of remaining component
-      }
-      else     // V is the root, pseudo_prim_dec is needed
-      {
-        QQ,SRest=pseudo_prim_dec_charsets(I,SI,choose);
-                         // QQ = quadruples:
-                         // standard basis of pseudo-primary component,
-                         // standard basis of corresponding prime,
-                         // seperator, irreducible factors of
-                         // the "minimal divisor" of the seperator
-                         // as computed by the procedure minsat,
-                         // SRest=standard basis of remaining component
-
-      }
-      //check
-      for(i=size(QQ);i>=1;i--)
-      //for(i=1;i<=size(QQ);i++)
-      {
-        tester=QQ[i][3]*V[4];
-        Qi=QQ[i][2];
-        if(NF(tester,Qi,1)!=0)  // the new vertex is not the
-                                // root of a redundant subtree
-        {
-          VV[1]=QQ[i][1];
-          VV[2]=2;
-          VV[3]=V[3]+1;
-          VV[4]=tester;      // the new tester as computed above
-          VV[5]=Qi;          // QQ[i][2];
-          VV[6]=list();
-          W=insert(W,VV,size(W));
-        }
-      }
-      if (SRest[1]!=1)        // the remaining component is not
-                              // the whole ring
-      {
-        if (rad_con(V[4],SRest)==0) // the vertex is not the root
-                                    // of a redundant subtree
-        {
-          VV[1]=SRest;
-          VV[2]=3;
-          VV[3]=V[3]+2;
-          VV[4]=V[4];      // the tester did not change
-          VV[5]=ideal(0);
-          WI=list();
-          for(i=1;i<=size(QQ);i++)
-          {
-            WI=insert(WI,list(QQ[i][2],QQ[i][4]));
-          }
-          VV[6]=WI;
-          W=insert(W,VV,size(W));
-        }
-      }
-    }
-  }
-}
-
-//////////////////////////////////////////////////////////////////////////
-// proc pseudo_prim_dec_charsets
-// input: Generators of an arbitrary ideal I, a standard basis SI of I,
-// and an integer choo
-// If choo=0, min_ass_prim_charsets with the given
-// ordering of the variables is used.
-// If choo=1, min_ass_prim_charsets with the "optimized"
-// ordering of the variables is used.
-// If choo=2, minAssPrimes from primdec.lib is used
-// If choo=3, minAssPrimes+factorizing Buchberger from primdec.lib is used
-// output: a pseudo primary decomposition of I, i.e., a list
-// of pseudo primary components together with a standard basis of the
-// remaining component. Each pseudo primary component is
-// represented by a quadrupel: A standard basis of the component,
-// a standard basis of the corresponding associated prime, the
-// seperator of the component, and the irreducible factors of the
-// "minimal divisor" of the seperator as computed by the procedure minsat,
-// calls  proc pseudo_prim_dec_i
-//////////////////////////////////////////////////////////////////////////
-
-
-static proc pseudo_prim_dec_charsets (ideal I, ideal SI, int choo)
-{
-  list L;          // The list of minimal associated primes,
-                   // each one given by a standard basis
-  if((choo==0) or (choo==1))
-  {
-    L=min_ass_prim_charsets(I,choo);
-  }
-  else
-  {
-    if(choo==2)
-    {
-      L=minAssPrimes(I);
-    }
-    else
-    {
-      L=minAssPrimes(I,1);
-    }
-    for(int i=size(L);i>=1;i--)
-    {
-      L[i]=std(L[i]);
-    }
-  }
-  return (pseudo_prim_dec_i(SI,L));
-}
-
-////////////////////////////////////////////////////////////////
-// proc pseudo_prim_dec_special_charsets
-// input: a standard basis of an ideal I whose radical is the
-// intersection of the radicals of ideals generated by one prime ideal
-// P_i together with one polynomial f_i, the list V6 must be the list of
-// pairs (standard basis of P_i, irreducible factors of f_i),
-// and an integer choo
-// If choo=0, min_ass_prim_charsets with the given
-// ordering of the variables is used.
-// If choo=1, min_ass_prim_charsets with the "optimized"
-// ordering of the variables is used.
-// If choo=2, minAssPrimes from primdec.lib is used
-// If choo=3, minAssPrimes+factorizing Buchberger from primdec.lib is used
-// output: a pseudo primary decomposition of I, i.e., a list
-// of pseudo primary components together with a standard basis of the
-// remaining component. Each pseudo primary component is
-// represented by a quadrupel: A standard basis of the component,
-// a standard basis of the corresponding associated prime, the
-// seperator of the component, and the irreducible factors of the
-// "minimal divisor" of the seperator as computed by the procedure minsat,
-// calls  proc pseudo_prim_dec_i
-////////////////////////////////////////////////////////////////
-
-
-static proc pseudo_prim_dec_special_charsets (ideal SI,list V6, int choo)
-{
-  int i,j,l;
-  list m;
-  list L;
-  int sizeL;
-  ideal P,SP; ideal fac;
-  int dimSP;
-  for(l=size(V6);l>=1;l--)   // creates a list of associated primes
-                             // of I, possibly redundant
-  {
-    P=V6[l][1];
-    fac=V6[l][2];
-    for(i=ncols(fac);i>=1;i--)
-    {
-      SP=P+fac[i];
-      SP=std(SP);
-      if(SP[1]!=1)
-      {
-        if((choo==0) or (choo==1))
-        {
-          m=min_ass_prim_charsets(SP,choo);  // a list of SB
-        }
-        else
-        {
-          if(choo==2)
-          {
-            m=minAssPrimes(SP);
-          }
-          else
-          {
-            m=minAssPrimes(SP,1);
-          }
-          for(j=size(m);j>=1;j=j-1)
-          {
-            m[j]=std(m[j]);
-          }
-        }
-        dimSP=dim(SP);
-        for(j=size(m);j>=1; j--)
-        {
-          if(dim(m[j])==dimSP)
-          {
-            L=insert(L,m[j],size(L));
-          }
-        }
-      }
-    }
-  }
-  sizeL=size(L);
-  for(i=1;i<sizeL;i++)     // get rid of redundant primes
-  {
-    for(j=i+1;j<=sizeL;j++)
-    {
-      if(size(L[i])!=0)
-      {
-        if(size(L[j])!=0)
-        {
-          if(size(NF(L[i],L[j],1))==0)
-          {
-            L[j]=ideal(0);
-          }
-          else
-          {
-            if(size(NF(L[j],L[i],1))==0)
-            {
-              L[i]=ideal(0);
-            }
-          }
-        }
-      }
-    }
-  }
-  for(i=sizeL;i>=1;i--)
-  {
-    if(size(L[i])==0)
-    {
-      L=delete(L,i);
-    }
-  }
-  return (pseudo_prim_dec_i(SI,L));
-}
-
-
-////////////////////////////////////////////////////////////////
-// proc pseudo_prim_dec_i
-// input: A standard basis of an arbitrary ideal I, and standard bases
-// of the minimal associated primes of I
-// output: a pseudo primary decomposition of I, i.e., a list
-// of pseudo primary components together with a standard basis of the
-// remaining component. Each pseudo primary component is
-// represented by a quadrupel: A standard basis of the component Q_i,
-// a standard basis of the corresponding associated prime P_i, the
-// seperator of the component, and the irreducible factors of the
-// "minimal divisor" of the seperator as computed by the procedure minsat,
-////////////////////////////////////////////////////////////////
-
-
-static proc pseudo_prim_dec_i (ideal SI, list L)
-{
-  list Q;
-  if (size(L)==1)               // one minimal associated prime only
-                                // the ideal is already pseudo primary
-  {
-    Q=SI,L[1],1;
-    list QQ;
-    QQ[1]=Q;
-    return (QQ,ideal(1));
-  }
-
-  poly f0,f,g;
-  ideal fac;
-  int i,j,k,l;
-  ideal SQi;
-  ideal I'=SI;
-  list QP;
-  int sizeL=size(L);
-  for(i=1;i<=sizeL;i++)
-  {
-    fac=0;
-    for(j=1;j<=sizeL;j++)           // compute the seperator sep_i
-                                    // of the i-th component
-    {
-      if (i!=j)                       // search g not in L[i], but L[j]
-      {
-        for(k=1;k<=ncols(L[j]);k++)
-        {
-          if(NF(L[j][k],L[i],1)!=0)
-          {
-            break;
-          }
-        }
-        fac=fac+L[j][k];
-      }
-    }
-    // delete superfluous polynomials
-    fac=simplify(fac,8+2);
-    // saturation
-    SQi,f0,f,fac=minsat_ppd(SI,fac);
-    I'=I',f;
-    QP=SQi,L[i],f0,fac;
-             // the quadrupel:
-             // a standard basis of Q_i,
-             // a standard basis of P_i,
-             // sep_i,
-             // irreducible factors of
-             // the "minimal divisor" of the seperator
-             //  as computed by the procedure minsat,
-    Q[i]=QP;
-  }
-  I'=std(I');
-  return (Q, I');
-                   // I' = remaining component
-}
-
-
-////////////////////////////////////////////////////////////////
-// proc extraction
-// input: A standard basis of a pseudo primary ideal I, and a standard
-// basis of the unique minimal associated prime P of I
-// output: an extraction of I, i.e., a standard basis of the primary
-// component Q of I with associated prime P, a standard basis of the
-// remaining component, and the irreducible factors of the
-// "minimal divisor" of the extractor as computed by the procedure minsat
-////////////////////////////////////////////////////////////////
-
-
-static proc extraction (ideal SI, ideal SP)
-{
-  list indsets=indepSet(SP,0);
-  poly f;
-  if(size(indsets)!=0)      //check, whether dim P != 0
-  {
-    intvec v;               // a maximal independent set of variables
-                            // modulo P
-    string U;               // the independent variables
-    string A;               // the dependent variables
-    int j,k;
-    int a;                  //  the size of A
-    int degf;
-    ideal g;
-    list polys;
-    int sizepolys;
-    list newpoly;
-    def R=basering;
-    //intvec hv=hilb(SI,1);
-    for (k=1;k<=size(indsets);k++)
-    {
-      v=indsets[k];
-      for (j=1;j<=nvars(R);j++)
-      {
-        if (v[j]==1)
-        {
-          U=U+varstr(j)+",";
-        }
-        else
-        {
-          A=A+varstr(j)+",";
-          a++;
-        }
-      }
-
-      U[size(U)]=")";           // we compute the extractor of I (w.r.t. U)
-      execute("ring RAU=("+charstr(basering)+"),("+A+U+",(dp("+string(a)+"),dp);");
-      ideal I=imap(R,SI);
-      //I=std(I,hv);            // the standard basis in (R[U])[A]
-      I=std(I);            // the standard basis in (R[U])[A]
-      A[size(A)]=")";
-      execute("ring Rloc=("+charstr(basering)+","+U+",("+A+",dp;");
-      ideal I=imap(RAU,I);
-      //"std in lokalisierung:"+newline,I;
-      ideal h;
-      for(j=ncols(I);j>=1;j--)
-      {
-        h[j]=leadcoef(I[j]);  // consider I in (R(U))[A]
-      }
-      setring R;
-      g=imap(Rloc,h);
-      kill RAU,Rloc;
-      U="";
-      A="";
-      a=0;
-      f=lcm(g);
-      newpoly[1]=f;
-      polys=polys+newpoly;
-      newpoly=list();
-    }
-    f=polys[1];
-    degf=deg(f);
-    sizepolys=size(polys);
-    for (k=2;k<=sizepolys;k++)
-    {
-      if (deg(polys[k])<degf)
-      {
-        f=polys[k];
-        degf=deg(f);
-      }
-    }
-  }
-  else
-  {
-    f=1;
-  }
-  poly f0,h0; ideal SQ; ideal fac;
-  if(f!=1)
-  {
-    SQ,f0,h0,fac=minsat(SI,f);
-    return(SQ,std(SI+h0),fac);
-             // the tripel
-             // a standard basis of Q,
-             // a standard basis of remaining component,
-             // irreducible factors of
-             // the "minimal divisor" of the extractor
-             // as computed by the procedure minsat
-  }
-  else
-  {
-    return(SI,ideal(1),ideal(1));
-  }
-}
-
-/////////////////////////////////////////////////////
-// proc minsat
-// input:  a standard basis of an ideal I and a polynomial p
-// output: a standard basis IS of the saturation of I w.r. to p,
-// the maximal squarefree factor f0 of p,
-// the "minimal divisor" f of f0 such that the saturation of
-// I w.r. to f equals the saturation of I w.r. to f0 (which is IS),
-// the irreducible factors of f
-//////////////////////////////////////////////////////////
-
-
-static proc minsat(ideal SI, poly p)
-{
-  ideal fac=factorize(p,1);       //the irreducible factors of p
-  fac=sort(fac)[1];
-  int i,k;
-  poly f0=1;
-  for(i=ncols(fac);i>=1;i--)
-  {
-    f0=f0*fac[i];
-  }
-  poly f=1;
-  ideal iold;
-  list quotM;
-  quotM[1]=SI;
-  quotM[2]=fac;
-  quotM[3]=f0;
-  // we deal seperately with the first quotient;
-  // factors, which do not contribute to this one,
-  // are omitted
-  iold=quotM[1];
-  quotM=minquot(quotM);
-  fac=quotM[2];
-  if(quotM[3]==1)
-  {
-    return(quotM[1],f0,f,fac);
-  }
-  while(special_ideals_equal(iold,quotM[1])==0)
-  {
-    f=f*quotM[3];
-    iold=quotM[1];
-    quotM=minquot(quotM);
-  }
-  return(quotM[1],f0,f,fac);           // the quadrupel ((I:p),f0,f, irr. factors of f)
-}
-
-/////////////////////////////////////////////////////
-// proc minsat_ppd
-// input:  a standard basis of an ideal I and a polynomial p
-// output: a standard basis IS of the saturation of I w.r. to p,
-// the maximal squarefree factor f0 of p,
-// the "minimal divisor" f of f0 such that the saturation of
-// I w.r. to f equals the saturation of I w.r. to f0 (which is IS),
-// the irreducible factors of f
-//////////////////////////////////////////////////////////
-
-
-static proc minsat_ppd(ideal SI, ideal fac)
-{
-  fac=sort(fac)[1];
-  int i,k;
-  poly f0=1;
-  for(i=ncols(fac);i>=1;i--)
-  {
-    f0=f0*fac[i];
-  }
-  poly f=1;
-  ideal iold;
-  list quotM;
-  quotM[1]=SI;
-  quotM[2]=fac;
-  quotM[3]=f0;
-  // we deal seperately with the first quotient;
-  // factors, which do not contribute to this one,
-  // are omitted
-  iold=quotM[1];
-  quotM=minquot(quotM);
-  fac=quotM[2];
-  if(quotM[3]==1)
-  {
-    return(quotM[1],f0,f,fac);
-  }
-  while(special_ideals_equal(iold,quotM[1])==0)
-  {
-    f=f*quotM[3];
-    iold=quotM[1];
-    quotM=minquot(quotM);
-    k++;
-  }
-  return(quotM[1],f0,f,fac);   // the quadrupel ((I:p),f0,f, irr. factors of f)
-}
-/////////////////////////////////////////////////////////////////
-// proc minquot
-// input: a list with 3 components: a standard basis
-// of an ideal I, a set of irreducible polynomials, and
-// there product f0
-// output: a standard basis of the ideal (I:f0), the irreducible
-// factors of the "minimal divisor" f of f0 with (I:f0) = (I:f),
-// the "minimal divisor" f
-/////////////////////////////////////////////////////////////////
-
-static proc minquot(list tsil)
-{
-  intvec op;
-  int i,j,k,action;
-  ideal verg;
-  list l;
-  poly g;
-  ideal laedi=tsil[1];
-  ideal fac=tsil[2];
-  poly f=tsil[3];
-
-//std
-//   ideal star=quotient(laedi,f);
-//   star=std(star);
-  op=option(get);
-  option(returnSB);
-  ideal star=quotient(laedi,f);
-  option(set,op);
-  if(special_ideals_equal(laedi,star)==1)
-  {
-    return(laedi,ideal(1),1);
-  }
-  action=1;
-  while(action==1)
-  {
-    if(size(fac)==1)
-    {
-      action=0;
-      break;
-    }
-    for(i=1;i<=size(fac);i++)
-    {
-      g=1;
-      for(j=1;j<=size(fac);j++)
-      {
-        if(i!=j)
-        {
-          g=g*fac[j];
-        }
-      }
-//std
-//         verg=quotient(laedi,g);
-//         verg=std(verg);
-      op=option(get);
-      option(returnSB);
-      verg=quotient(laedi,g);
-      option(set,op);
-      if(special_ideals_equal(verg,star)==1)
-      {
-        f=g;
-        fac[i]=0;
-        fac=simplify(fac,2);
-        break;
-      }
-      if(i==size(fac))
-      {
-        action=0;
-      }
-    }
-  }
-  l=star,fac,f;
-  return(l);
-}
-/////////////////////////////////////////////////
-// proc special_ideals_equal
-// input: standard bases of ideal k1 and k2 such that
-// k1 is contained in k2, or k2 is contained ink1
-// output: 1, if k1 equals k2, 0 otherwise
-//////////////////////////////////////////////////
-
-static proc special_ideals_equal( ideal k1, ideal k2)
-{
-  int j;
-  if(size(k1)==size(k2))
-  {
-    for(j=1;j<=size(k1);j++)
-    {
-      if(leadexp(k1[j])!=leadexp(k2[j]))
-      {
-        return(0);
-      }
-    }
-    return(1);
-  }
-  return(0);
-}
-
-
-///////////////////////////////////////////////////////////////////////////////
-
-static proc convList(list l)
-{
-  int i;
-  list re,he;
-  for(i=1;i<=size(l)/2;i++)
-  {
-    he=l[2*i-1],l[2*i];
-    re[i]=he;
-  }
-  return(re);
-}
-///////////////////////////////////////////////////////////////////////////////
-
-static proc reconvList(list l)
-{
-  int i;
-  list re;
-  for(i=1;i<=size(l);i++)
-  {
-    re[2*i-1]=l[i][1];
-    re[2*i]=l[i][2];
-  }
-  return(re);
-}
-
-///////////////////////////////////////////////////////////////////////////////
-//
-//     The main procedures
-//
-///////////////////////////////////////////////////////////////////////////////
-
-proc primdecGTZ(ideal i)
-"USAGE:   primdecGTZ(i); i ideal
-RETURN:  a list pr of primary ideals and their associated primes:
-@format
-   pr[i][1]   the i-th primary component,
-   pr[i][2]   the i-th prime component.
-@end format
-NOTE:    Algorithm of Gianni/Trager/Zacharias.
-         Designed for characteristic 0, works also in char k > 0, if it
-         terminates (may result in an infinite loop in small characteristic!)
-EXAMPLE: example primdecGTZ; shows an example
-"
-{
-  if(attrib(basering,"global")!=1)
-  {
-    ERROR(
-      "// Not implemented for this ordering, please change to global ordering."
-    );
-  }
-  if(minpoly!=0)
-  {
-    return(algeDeco(i,0));
-    ERROR(
-      "// Not implemented yet for algebraic extensions.Simulate the ring extension by adding the minpoly to the ideal"
-    );
-  }
-  return(convList(decomp(i)));
-}
-example
-{ "EXAMPLE:";  echo = 2;
-   ring  r = 0,(x,y,z),lp;
-   poly  p = z2+1;
-   poly  q = z3+2;
-   ideal i = p*q^2,y-z2;
-   list pr = primdecGTZ(i);
-   pr;
-}
-///////////////////////////////////////////////////////////////////////////////
-
-proc absPrimdecGTZ(ideal I)
-"USAGE:   absPrimdecGTZ(I); I ideal
-ASSUME:  Ground field has characteristic 0.
-RETURN:  a ring containing two lists: @code{absolute_primes} (the absolute
-         prime components of I) and @code{primary_decomp} (the output of
-         @code{primdecGTZ(I)}).
-         The list absolute_primes has to be interpreted as follows:
-         each entry describes a class of conjugated absolute primes,
-@format
-   absolute_primes[i][1]   the absolute prime component,
-   absolute_primes[i][2]   the number of conjugates.
-@end format
-         The first entry of @code{absolute_primes[i][1]} is the minimal
-         polynomial of a minimal finite field extension over which the
-         absolute prime component is defined.
-NOTE:    Algorithm of Gianni/Trager/Zacharias combined with the
-         @code{absFactorize} command.
-SEE ALSO: primdecGTZ; absFactorize
-EXAMPLE: example absPrimdecGTZ; shows an example
-"
-{
-  if (char(basering) != 0)
-  {
-    ERROR("primdec.lib::absPrimdecGTZ is only implemented for "+
-           +"characteristic 0");
-  }
-
-  if(attrib(basering,"global")!=1)
-  {
-    ERROR(
-      "// Not implemented for this ordering, please change to global ordering."
-    );
-  }
-  if(minpoly!=0)
-  {
-    //return(algeDeco(i,0));
-    ERROR(
-      "// Not implemented yet for algebraic extensions.Simulate the ring extension by adding the minpoly to the ideal"
-    );
-  }
-  def R=basering;
-  int n=nvars(R);
-  list L=decomp(I,3);
-  string newvar=L[1][3];
-  int k=find(newvar,",",find(newvar,",")+1);
-  newvar=newvar[k+1..size(newvar)];
-  list lR=ringlist(R);
-  int i,d;
-  intvec vv;
-  for(i=1;i<=n;i++){vv[i]=1;}
-
-  list orst;
-  orst[1]=list("dp",vv);
-  orst[2]=list("dp",intvec(1));
-  orst[3]=list("C",0);
-  lR[3]=orst;
-  lR[2][n+1] = newvar;
-  def Rz = ring(lR);
-  setring Rz;
-  list L=imap(R,L);
-  list absolute_primes,primary_decomp;
-  ideal I,M,N,K;
-  M=maxideal(1);
-  N=maxideal(1);
-  poly p,q,f,g;
-  map phi,psi;
-  for(i=1;i<=size(L);i++)
-  {
-    I=L[i][2];
-    execute("K="+L[i][3]+";");
-    p=K[1];
-    q=K[2];
-    execute("f="+L[i][4]+";");
-    g=2*var(n)-f;
-    M[n]=f;
-    N[n]=g;
-    d=deg(p);
-    phi=Rz,M;
-    psi=Rz,N;
-    I=phi(I),p,q;
-    I=std(I);
-    absolute_primes[i]=list(psi(I),d);
-    primary_decomp[i]=list(L[i][1],L[i][2]);
-  }
-  export(primary_decomp);
-  export(absolute_primes);
-  setring R;
-  dbprint( printlevel-voice+3,"
-// 'absPrimdecGTZ' created a ring, in which two lists absolute_primes (the
-// absolute prime components) and primary_decomp (the primary and prime
-// components over the current basering) are stored.
-// To access the list of absolute prime components, type (if the name S was
-// assigned to the return value):
-        setring S; absolute_primes; ");
-
-  return(Rz);
-}
-example
-{ "EXAMPLE:";  echo = 2;
-   ring  r = 0,(x,y,z),lp;
-   poly  p = z2+1;
-   poly  q = z3+2;
-   ideal i = p*q^2,y-z2;
-   def S = absPrimdecGTZ(i);
-   setring S;
-   absolute_primes;
-}
-///////////////////////////////////////////////////////////////////////////////
-
-proc primdecSY(ideal i, list #)
-"USAGE:   primdecSY(I, c); I ideal, c int (optional)
-RETURN:  a list pr of primary ideals and their associated primes:
-@format
-   pr[i][1]   the i-th primary component,
-   pr[i][2]   the i-th prime component.
-@end format
-NOTE:    Algorithm of Shimoyama/Yokoyama.
-@format
-   if c=0,  the given ordering of the variables is used,
-   if c=1,  minAssChar tries to use an optimal ordering (default),
-   if c=2,  minAssGTZ is used,
-   if c=3,  minAssGTZ and facstd are used.
-@end format
-EXAMPLE: example primdecSY; shows an example
-"
-{
-  if(attrib(basering,"global")!=1)
-  {
-    ERROR(
-      "// Not implemented for this ordering, please change to global ordering."
-    );
-  }
-  i=simplify(i,2);
-  if ((i[1]==0)||(i[1]==1))
-  {
-   list L=list(ideal(i[1]),ideal(i[1]));
-   return(list(L));
-  }
-  if(minpoly!=0)
-  {
-    return(algeDeco(i,1));
-  }
-  if (size(#)==1)
-  { return(prim_dec(i,#[1])); }
-  else
-  { return(prim_dec(i,1)); }
-}
-example
-{ "EXAMPLE:";  echo = 2;
-   ring  r = 0,(x,y,z),lp;
-   poly  p = z2+1;
-   poly  q = z3+2;
-   ideal i = p*q^2,y-z2;
-   list pr = primdecSY(i);
-   pr;
-}
-///////////////////////////////////////////////////////////////////////////////
-proc minAssGTZ(ideal i,list #)
-"USAGE:    minAssGTZ(I[, l]); I ideal, l list (optional)
-   @* Optional parameters in list l (can be entered in any order):
-   @* 0, \"facstd\" -> uses facstd to first decompose the ideal (default)
-   @* 1, \"noFacstd\" -> does not use facstd
-   @* \"GTZ\" -> the original algorithm by Gianni, Trager and Zacharias is used
-   @* \"SL\" -> GTZ algorithm with modificiations by Laplagne is used (default)
-
-RETURN:  a list, the minimal associated prime ideals of I.
-NOTE:    Designed for characteristic 0, works also in char k > 0 based
-         on an algorithm of Yokoyama
-EXAMPLE: example minAssGTZ; shows an example
-"
-{
-  int j;
-  string algorithm;
-  string facstdOption;
-  int useFac;
-
-  // Set input parameters
-  algorithm = "SL";         // Default: SL algorithm
-  facstdOption = "facstd";
-  if(size(#) > 0)
-  {
-    int valid;
-    for(j = 1; j <= size(#); j++)
-    {
-      valid = 0;
-      if((typeof(#[j]) == "int") or (typeof(#[j]) == "number"))
-      {
-        if (#[j] == 1) {facstdOption = "noFacstd"; valid = 1;}    // If #[j] == 1, facstd is not used.
-        if (#[j] == 0) {facstdOption = "facstd";   valid = 1;}    // If #[j] == 0, facstd is used.
-      }
-      if(typeof(#[j]) == "string")
-      {
-        if((#[j] == "GTZ") || (#[j] == "SL"))
-        {
-          algorithm = #[j];
-          valid = 1;
-        }
-        if((#[j] == "noFacstd") || (#[j] == "facstd"))
-        {
-          facstdOption = #[j];
-          valid = 1;
-        }
-      }
-      if(valid == 0)
-      {
-        dbprint(1, "Warning! The following input parameter was not recognized:", #[j]);
-      }
-    }
-  }
-
-  if(attrib(basering,"global")!=1)
-  {
-    ERROR(
-      "// Not implemented for this ordering, please change to global ordering."
-    );
-  }
-  if(minpoly!=0)
-  {
-    return(algeDeco(i,2));
-  }
-
-  list result = minAssPrimes(i, facstdOption, algorithm);
-  return(result);
-}
-example
-{ "EXAMPLE:";  echo = 2;
-   ring  r = 0,(x,y,z),dp;
-   poly  p = z2+1;
-   poly  q = z3+2;
-   ideal i = p*q^2,y-z2;
-   list pr = minAssGTZ(i);
-   pr;
-}
-
-///////////////////////////////////////////////////////////////////////////////
-proc minAssChar(ideal i, list #)
-"USAGE:   minAssChar(I[,c]); i ideal, c int (optional).
-RETURN:  list, the minimal associated prime ideals of i.
-NOTE:    If c=0, the given ordering of the variables is used. @*
-         Otherwise, the system tries to find an optimal ordering,
-         which in some cases may considerably speed up the algorithm. @*
-         Due to a bug in the factorization, the result may be not completely
-         decomposed in small characteristic.
-EXAMPLE: example minAssChar; shows an example
-"
-{
-  if(attrib(basering,"global")!=1)
-  {
-    ERROR(
-      "// Not implemented for this ordering, please change to global ordering."
-    );
-  }
-  if (size(#)==1)
-  { return(min_ass_prim_charsets(i,#[1])); }
-  else
-  { return(min_ass_prim_charsets(i,1)); }
-}
-example
-{ "EXAMPLE:";  echo = 2;
-   ring  r = 0,(x,y,z),dp;
-   poly  p = z2+1;
-   poly  q = z3+2;
-   ideal i = p*q^2,y-z2;
-   list pr = minAssChar(i);
-   pr;
-}
-///////////////////////////////////////////////////////////////////////////////
-proc equiRadical(ideal i)
-"USAGE:   equiRadical(I); I ideal
-RETURN:  ideal, intersection of associated primes of I of maximal dimension.
-NOTE:    A combination of the algorithms of Krick/Logar (with modifications by Laplagne) and Kemper is used.
-         Works also in positive characteristic (Kempers algorithm).
-EXAMPLE: example equiRadical; shows an example
-"
-{
-  if(attrib(basering,"global")!=1)
-  {
-    ERROR(
-     "// Not implemented for this ordering, please change to global ordering."
-    );
-  }
-  return(radical(i, 1));
-}
-example
-{ "EXAMPLE:";  echo = 2;
-   ring  r = 0,(x,y,z),dp;
-   poly  p = z2+1;
-   poly  q = z3+2;
-   ideal i = p*q^2,y-z2;
-   ideal pr= equiRadical(i);
-   pr;
-}
-
-///////////////////////////////////////////////////////////////////////////////
-proc radical(ideal i, list #)
-"USAGE: radical(I[, l]); I ideal, l list (optional)
- @*  Optional parameters in list l (can be entered in any order):
- @*  0, \"fullRad\" -> full radical is computed (default)
- @*  1, \"equiRad\" -> equiRadical is computed
- @*  \"KL\" -> Krick/Logar algorithm is used
- @*  \"SL\" -> modifications by Laplagne are used (default)
- @*  \"facstd\" -> uses facstd to first decompose the ideal (default for non homogeneous ideals)
- @*  \"noFacstd\" -> does not use facstd (default for homogeneous ideals)
-RETURN:  ideal, the radical of I (or the equiradical if required in the input parameters)
-NOTE:    A combination of the algorithms of Krick/Logar (with modifications by Laplagne) and Kemper is used.
-         Works also in positive characteristic (Kempers algorithm).
-EXAMPLE: example radical; shows an example
-"
-{
-  dbprint(printlevel - voice, "Radical, version 2006.05.08");
-  if(attrib(basering,"global")!=1)
-  {
-    ERROR(
-     "// Not implemented for this ordering, please change to global ordering."
-    );
-  }
-  if(size(i) == 0){return(ideal(0));}
-  int j;
-  def P0 = basering;
-  list Pl=ringlist(P0);
-  intvec dp_w;
-  for(j=nvars(P0);j>0;j--) {dp_w[j]=1;}
-  Pl[3]=list(list("dp",dp_w),list("C",0));
-  def @P=ring(Pl);
-  setring @P;
-  ideal i=imap(P0,i);
-
-  int il;
-  string algorithm;
-  int useFac;
-
-  // Set input parameters
-  algorithm = "SL";                                 // Default: SL algorithm
-  il = 0;                                           // Default: Full radical (not only equiRadical)
-  if (homog(i) == 1)
-  {   // Default: facStd is used, except if the ideal is homogeneous.
-    useFac = 0;
-  }
-  else
-  {
-    useFac = 1;
-  }
-  if(size(#) > 0)
-  {
-    int valid;
-    for(j = 1; j <= size(#); j++)
-    {
-      valid = 0;
-      if((typeof(#[j]) == "int") or (typeof(#[j]) == "number"))
-      {
-        il = #[j];          // If il == 1, equiRadical is computed
-        valid = 1;
-      }
-      if(typeof(#[j]) == "string")
-      {
-        if(#[j] == "KL")
-        {
-          algorithm = "KL";
-          valid = 1;
-        }
-        if(#[j] == "SL")
-        {
-          algorithm = "SL";
-          valid = 1;
-        }
-        if(#[j] == "noFacstd")
-        {
-          useFac = 0;
-          valid = 1;
-        }
-        if(#[j] == "facstd")
-        {
-          useFac = 1;
-          valid = 1;
-        }
-        if(#[j] == "equiRad")
-        {
-          il = 1;
-          valid = 1;
-        }
-        if(#[j] == "fullRad")
-        {
-          il = 0;
-          valid = 1;
-        }
-      }
-      if(valid == 0)
-      {
-        dbprint(1, "Warning! The following input parameter was not recognized:", #[j]);
-      }
-    }
-  }
-
-  ideal rad = 1;
-  intvec op = option(get);
-  list qr = simplifyIdeal(i);
-  map phi = @P, qr[2];
-
-  option(redSB);
-  i = groebner(qr[1]);
-  option(set, op);
-  int di = dim(i);
-
-  if(di == 0)
-  {
-    i = zeroRad(i, qr[1]);
-    i=interred(phi(i));
-    setring(P0);
-    i=imap(@P,i);
-    return(i);
-  }
-
-  option(redSB);
-  list pr;
-  if(useFac == 1)
-  {
-    pr = facstd(i);
-  }
-  else
-  {
-    pr = i;
-  }
-  option(set, op);
-  int s = size(pr);
-  if(useFac == 1)
-  {
-    dbprint(printlevel - voice, "Number of components returned by facstd: ", s);
-  }
-  for(j = 1; j <= s; j++)
-  {
-    attrib(pr[s + 1 - j], "isSB", 1);
-    if((size(reduce(rad, pr[s + 1 - j], 1)) != 0) && ((dim(pr[s + 1 - j]) == di) || !il))
-    {
-      // SL Debug messages
-      dbprint(printlevel-voice, "We shall compute the radical of ", pr[s + 1 - j]);
-      dbprint(printlevel-voice, "The dimension is: ", dim(pr[s+1-j]));
-
-      if(algorithm == "KL")
-      {
-        rad = intersect(rad, radicalKL(pr[s + 1 - j], rad, il));
-      }
-      if(algorithm == "SL")
-      {
-        rad = intersect(rad, radicalSL(pr[s + 1 - j], il));
-      }
-    }
-    else
-    {
-      // SL Debug
-      dbprint(printlevel-voice, "The radical of this component is not needed.");
-      dbprint(printlevel-voice, "size(reduce(rad, pr[s + 1 - j], 1))",
-              size(reduce(rad, pr[s + 1 - j], 1)));
-      dbprint(printlevel-voice, "dim(pr[s + 1 - j])", dim(pr[s + 1 - j]));
-      dbprint(printlevel-voice, "il", il);
-    }
-  }
-  rad=interred(phi(rad));
-  setring(P0);
-  i=imap(@P,rad);
-  return(i);
-}
-example
-{ "EXAMPLE:";  echo = 2;
-   ring  r = 0,(x,y,z),dp;
-   poly  p = z2+1;
-   poly  q = z3+2;
-   ideal i = p*q^2,y-z2;
-   ideal pr = radical(i);
-   pr;
-}
-
-///////////////////////////////////////////////////////////////////////////////
-//
-// Computes the radical of I using KL algorithm.
-// The only difference with the the previous implementation of KL algorithm is
-// that now it uses block dp instead of lp ordering for the reduction to the
-// zerodimensional case.
-// The reduction step has been moved to the new routine radicalReduction, so that it can be
-// used also by radicalSL procedure.
-//
-static proc radicalKL(ideal I, ideal ser, list #)
-{
-// ideal I     The ideal for which the radical is computed
-// ideal ser   Used to reduce components already obtained
-// list #      If #[1] = 1, equiradical is computed.
-
-  // I needs to be a Groebner basis.
-  if (attrib(I, "isSB") != 1)
-  {
-    I = groebner(I);
-  }
-
-  ideal rad;                                // The radical
-  int allIndep = 1;                // All max independent sets are used
-
-  list result = radicalReduction(I, ser, allIndep, #);
-  int done = result[3];
-  rad = result[1];
-  if (done == 0)
-  {
-    rad = intersect(rad, radicalKL(result[2], ideal(1), #));
-  }
-  return(rad);
-}
-
-
-///////////////////////////////////////////////////////////////////////////////
-//
-// Computes the radical of I via Laplagne algorithm, using zerodimensional radical in
-// the zero dimensional case.
-// For the reduction to the zerodimensional case, it uses the procedure
-// radical, with some modifications to avoid the recursion.
-//
-static proc radicalSL(ideal I, list #)
-// Input = I, ideal
-//         #, list. If #[1] = 1, then computes only the equiradical.
-// Output = (P, primaryDec) where P = rad(I) and primaryDec is the list of the radicals
-// obtained in intermediate steps.
-{
-  ideal rad = 1;
-  ideal equiRad = 1;
-  list primes;
-  int k;                        // Counter
-  int il;                 // If il = 1, only the equiradical is required.
-  int iDim;                // The dimension of I
-  int stop = 0;   // Checks if the radical has been obtained
-
-  if (attrib(I, "isSB") != 1)
-  {
-    I = groebner(I);
-  }
-  iDim = dim(I);
-
-  // Checks if only equiradical is required
-  if (size(#) > 0)
-  {
-    il = #[1];
-  }
-
-  while(stop == 0)
-  {
-    dbprint (printlevel-voice, "// We call radLoopR to find new prime ideals.");
-    primes = radicalSLIteration(I, rad);                         // A list of primes or intersections of primes, not included in P
-    dbprint (printlevel - voice, "// Output of Iteration Step:");
-    dbprint (printlevel - voice, primes);
-    if (size(primes) > 0)
-    {
-      dbprint (printlevel - voice, "// We intersect P with the ideal just obtained.");
-      for(k = 1; k <= size(primes); k++)
-      {
-        rad = intersect(rad, primes[k]);
-        if (il == 1)
-        {
-          if (attrib(primes[k], "isSB") != 1)
-          {
-            primes[k] = groebner(primes[k]);
-          }
-          if (iDim == dim(primes[k]))
-          {
-            equiRad = intersect(equiRad, primes[k]);
-          }
-        }
-      }
-    }
-    else
-    {
-      stop = 1;
-    }
-  }
-  if (il == 0)
-  {
-    return(rad);
-  }
-  else
-  {
-    return(equiRad);
-  }
-}
-
-//////////////////////////////////////////////////////////////////////////
-// Based on radicalKL.
-// It contains all of old version of proc radicalKL except the recursion call.
-
-// Output:
-// #1 -> output ideal, the part of the radical that has been computed
-// #2 -> complementary ideal, the part of the ideal I whose radical remains to be computed
-//       = (I, h) in KL algorithm
-//       This is not used in the new algorithm. It is part of KL algorithm
-// #3 -> done, 1: output = radical, there is no need to continue
-//                   0: radical = output \cap \sqrt{complementary ideal}
-//       This is not used in the new algorithm. It is part of KL algorithm
-
-static proc radicalReduction(ideal I, ideal ser, int allIndep, list #)
-{
-// allMaximal                1 -> Indicates that the reduction to the zerodim case
-//                       must be done for all indep set of the leading terms ideal
-//                                        0 -> Otherwise
-// ideal ser                Only for radicalKL. (Same as in radicalKL)
-// list #                        Only for radicalKL (If #[1] = 1, only equiradical is required.
-//                  It is used to set the value of done.)
-
-  attrib(I, "isSB", 1);   // I needs to be a reduced standard basis
-  list indep, fett;
-  intvec @w, @hilb, op;
-  int @wr, @n, @m, lauf, di;
-  ideal fac, @h, collectrad, lsau;
-  poly @q;
-  string @va, quotring;
-
-  def @P = basering;
-  int jdim = dim(I);               // Computes the dimension of I
-  int  homo = homog(I);            // Finds out if I is homogeneous
-  ideal rad = ideal(1);            // The unit ideal
-  ideal te = ser;
-  if(size(#) > 0)
-  {
-    @wr = #[1];
-  }
-  if(homo == 1)
-  {
-    for(@n = 1; @n <= nvars(basering); @n++)
-    {
-      @w[@n] = ord(var(@n));
-    }
-    @hilb = hilb(I, 1, @w);
-  }
-
-  // SL 2006.04.11 1 Debug messages
-  dbprint(printlevel-voice, "//Computes the radical of the ideal:", I);
-  // SL 2006.04.11 2 Debug messages
-
-  //---------------------------------------------------------------------------
-  //j is the ring
-  //---------------------------------------------------------------------------
-
-  if (jdim==-1)
-  {
-    return(ideal(1), ideal(1), 1);
-  }
-
-  //---------------------------------------------------------------------------
-  //the zero-dimensional case
-  //---------------------------------------------------------------------------
-
-  if (jdim==0)
-  {
-    return(zeroRad(I), ideal(1), 1);
-  }
-
-  //-------------------------------------------------------------------------
-  //search for a maximal independent set indep,i.e.
-  //look for subring such that the intersection with the ideal is zero
-  //j intersected with K[var(indep[3]+1),...,var(nvar)] is zero,
-  //indep[1] is the new varstring, indep[2] the string for the block-ordering
-  //-------------------------------------------------------------------------
-
-  // SL 2006-04-24 1         If allIndep = 0, then it only computes one maximal
-  //                                        independent set.
-  //                                        This looks better for the new algorithm but not for KL
-  //                                        algorithm
-  list parameters = allIndep;
-  indep = newMaxIndependSetDp(I, parameters);
-  // SL 2006-04-24 2
-
-  for(@m = 1; @m <= size(indep); @m++)
-  {
-    if((indep[@m][1] == varstr(basering)) && (@m == 1))
-    //this is the good case, nothing to do, just to have the same notations
-    //change the ring
-    {
-      execute("ring gnir1 = ("+charstr(basering)+"),("+varstr(basering)+"),("
-                              +ordstr(basering)+");");
-      ideal @j = fetch(@P, I);
-      attrib(@j, "isSB", 1);
-    }
-    else
-    {
-      @va = string(maxideal(1));
-
-      execute("ring gnir1 = (" + charstr(basering) + "), (" + indep[@m][1] + "),("
-                              + indep[@m][2] + ");");
-      execute("map phi = @P," + @va + ";");
-      if(homo == 1)
-      {
-        ideal @j = std(phi(I), @hilb, @w);
-      }
-      else
-      {
-        ideal @j = groebner(phi(I));
-      }
-    }
-    if((deg(@j[1]) == 0) || (dim(@j) < jdim))
-    {
-      setring @P;
-      break;
-    }
-    for (lauf = 1; lauf <= size(@j); lauf++)
-    {
-      fett[lauf] = size(@j[lauf]);
-    }
-    //------------------------------------------------------------------------
-    // We have now the following situation:
-    // j intersected with K[var(nnp+1),..,var(nva)] is zero so we may pass
-    // to this quotientring, j is there still a standardbasis, the
-    // leading coefficients of the polynomials there (polynomials in
-    // K[var(nnp+1),..,var(nva)]) are collected in the list h,
-    // we need their LCM, gh, because of the following:
-    // let (j:gh^n)=(j:gh^infinity) then j*K(var(nnp+1),..,var(nva))[..rest..]
-    // intersected with K[var(1),...,var(nva)] is (j:gh^n)
-    // on the other hand j = ((j, gh^n) intersected with (j : gh^n))
-
-    //------------------------------------------------------------------------
-    // The arrangement for the quotientring K(var(nnp+1),..,var(nva))[..rest..]
-    // and the map phi:K[var(1),...,var(nva)] ----->
-    // K(var(nnpr+1),..,var(nva))[..the rest..]
-    //------------------------------------------------------------------------
-    quotring = prepareQuotientRingDp(nvars(basering) - indep[@m][3]);
-    //------------------------------------------------------------------------
-    // We pass to the quotientring   K(var(nnp+1),..,var(nva))[..the rest..]
-    //------------------------------------------------------------------------
-
-    execute(quotring);
-
-    // @j considered in the quotientring
-    ideal @j = imap(gnir1, @j);
-
-    kill gnir1;
-
-    // j is a standardbasis in the quotientring but usually not minimal
-    // here it becomes minimal
-
-    @j = clearSB(@j, fett);
-
-    // We need later LCM(h[1],...) = gh for saturation
-    ideal @h;
-    if(deg(@j[1]) > 0)
-    {
-      for(@n = 1; @n <= size(@j); @n++)
-      {
-        @h[@n] = leadcoef(@j[@n]);
-      }
-      op = option(get);
-      option(redSB);
-      @j = interred(@j);  //to obtain a reduced standardbasis
-      attrib(@j, "isSB", 1);
-      option(set, op);
-
-      // SL 1 Debug messages
-      dbprint(printlevel - voice, "zero_rad", basering, @j, dim(groebner(@j)));
-      ideal zero_rad = zeroRad(@j);
-      dbprint(printlevel - voice, "zero_rad passed");
-      // SL 2
-    }
-    else
-    {
-      ideal zero_rad = ideal(1);
-    }
-
-    // We need the intersection of the ideals in the list quprimary with the
-    // polynomialring, i.e. let q=(f1,...,fr) in the quotientring such an ideal
-    // but fi polynomials, then the intersection of q with the polynomialring
-    // is the saturation of the ideal generated by f1,...,fr with respect to
-    // h which is the lcm of the leading coefficients of the fi considered in
-    // the quotientring: this is coded in saturn
-
-    zero_rad = std(zero_rad);
-
-    ideal hpl;
-
-    for(@n = 1; @n <= size(zero_rad); @n++)
-    {
-      hpl = hpl, leadcoef(zero_rad[@n]);
-    }
-
-    //------------------------------------------------------------------------
-    // We leave  the quotientring   K(var(nnp+1),..,var(nva))[..the rest..]
-    // back to the polynomialring
-    //------------------------------------------------------------------------
-    setring @P;
-
-    collectrad = imap(quring, zero_rad);
-    lsau = simplify(imap(quring, hpl), 2);
-    @h = imap(quring, @h);
-
-    kill quring;
-
-    // Here the intersection with the polynomialring
-    // mentioned above is really computed
-
-    collectrad = sat2(collectrad, lsau)[1];
-    if(deg(@h[1])>=0)
-    {
-      fac = ideal(0);
-      for(lauf = 1; lauf <= ncols(@h); lauf++)
-      {
-        if(deg(@h[lauf]) > 0)
-        {
-          fac = fac + factorize(@h[lauf], 1);
-        }
-      }
-      fac = simplify(fac, 6);
-      @q = 1;
-      for(lauf = 1; lauf <= size(fac); lauf++)
-      {
-        @q = @q * fac[lauf];
-      }
-      op = option(get);
-      option(returnSB);
-      option(redSB);
-      I = quotient(I + ideal(@q), rad);
-      attrib(I, "isSB", 1);
-      option(set, op);
-    }
-    if((deg(rad[1]) > 0) && (deg(collectrad[1]) > 0))
-    {
-      rad = intersect(rad, collectrad);
-      te = intersect(te, collectrad);
-      te = simplify(reduce(te, I, 1), 2);
-    }
-    else
-    {
-      if(deg(collectrad[1]) > 0)
-      {
-        rad = collectrad;
-        te = intersect(te, collectrad);
-        te = simplify(reduce(te, I, 1), 2);
-      }
-    }
-
-    if((dim(I) < jdim)||(size(te) == 0))
-    {
-      break;
-    }
-    if(homo==1)
-    {
-      @hilb = hilb(I, 1, @w);
-    }
-  }
-
-  // SL 2006.04.11 1 Debug messages
-  dbprint (printlevel-voice, "// Part of the Radical already computed:", rad);
-  dbprint (printlevel-voice, "// Dimension:", dim(groebner(rad)));
-  // SL 2006.04.11 2 Debug messages
-
-  // SL 2006.04.21 1         New variable "done".
-  //                                        It tells if the radical is already computed or
-  //                                        if it still has to be computed the radical of the new ideal I
-  int done;
-  if(((@wr == 1) && (dim(I)<jdim)) || (deg(I[1])==0) || (size(te) == 0))
-  {
-    done = 1;
-  }
-  else
-  {
-    done = 0;
-  }
-  // SL 2006.04.21 2
-
-  // SL 2006.04.21 1         See details of the output at the beggining of this proc.
-  list result = rad, I, done;
-  return(result);
-  // SL 2006.04.21 2
-}
-
-
-///////////////////////////////////////////////////////////////////////////////
-// Given an ideal I and an ideal P (intersection of some minimal prime ideals
-// associated to I), it calculates the intersection of new minimal prime ideals
-// associated to I which where not used to calculate P.
-// This version uses ZD Radical in the zerodimensional case.
-static proc radicalSLIteration (ideal I, ideal P);
-// Input: I, ideal. The ideal from which new prime components will be obtained.
-//        P, ideal. Intersection of some prime ideals of I.
-// Output: ideal. Intersection of some primes of I different from the ones in P.
-{
-  int k = 1;                                // Counter
-  int good  = 0;                        // Checks if an element of P is in rad(I)
-
-  dbprint (printlevel-voice, "// We search for an element in P - sqrt(I).");
-  while ((k <= size(P)) and (good == 0))
-  {
-    dbprint (printlevel-voice, "// We try with:", P[k]);
-    good = 1 - rad_con(P[k], I);
-    k++;
-  }
-  k--;
-  if (good == 0)
-  {
-    dbprint (printlevel-voice, "// No element was found, P = sqrt(I).");
-    list emptyList = list();
-    return (emptyList);
-  }
-  dbprint(printlevel - voice, "// That one was good!");
-  dbprint(printlevel - voice, "// We saturate I with respect to this element.");
-  if (P[k] != 1)
-  {
-    ideal J = sat(I, P[k])[1];
-    }
-    else
-    {
-      dbprint(printlevel - voice, "// The polynomial is 1, the saturation in not actually computed.");
-      ideal J = I;
-    }
-
-    // We now call proc radicalNew;
-    dbprint(printlevel - voice, "// We do the reduction to the zerodimensional case, via radical.");
-    dbprint(printlevel - voice, "// The ideal is ", J);
-    dbprint(printlevel - voice, "// The dimension is ", dim(groebner(J)));
-
-    int allMaximal = 0;                   // Compute the zerodim reduction for only one indep set.
-    ideal re = 1;                           // No reduction is need, there are not redundant components.
-    list emptyList = list();   // Look for primes of any dimension, not only of max dimension.
-    list result = radicalReduction(J, re, allMaximal, emptyList);
-
-    return(result[1]);
-}
-
-///////////////////////////////////////////////////////////////////////////////////
-// Based on maxIndependSet
-// Added list # as parameter
-// If the first element of # is 0, the output is only 1 max indep set.
-// If no list is specified or #[1] = 1, the output is all the max indep set of the
-// leading terms ideal. This is the original output of maxIndependSet
-
-// The ordering given in the output has been changed to block dp instead of lp.
-
-proc newMaxIndependSetDp(ideal j, list #)
-"USAGE:   newMaxIndependentSetDp(I); I ideal (returns all maximal independent sets of the corresponding leading terms ideal)
-          newMaxIndependentSetDp(I, 0); I ideal (returns only one maximal independent set)
-RETURN:  list = #1. new varstring with the maximal independent set at the end,
-                #2. ordstring with the corresponding dp block ordering,
-                #3. the number of independent variables
-NOTE:
-EXAMPLE: example newMaxIndependentSetDp; shows an example
-"
-{
-  int n, k, di;
-  list resu, hilf;
-  string var1, var2;
-  list v = indepSet(j, 0);
-
-  // SL 2006.04.21 1 Lines modified to use only one independent Set
-  int allMaximal;
-  if (size(#) > 0)
-  {
-    allMaximal = #[1];
-   }
-   else
-   {
-     allMaximal = 1;
-   }
-
-   int nMax;
-   if (allMaximal == 1)
-   {
-     nMax = size(v);
-   }
-   else
-   {
-     nMax = 1;
-   }
-
-   for(n = 1; n <= nMax; n++)
-   // SL 2006.04.21 2
-   {
-     di = 0;
-     var1 = "";
-     var2 = "";
-     for(k = 1; k <= size(v[n]); k++)
-     {
-       if(v[n][k] != 0)
-       {
-         di++;
-         var2 = var2 + "var(" + string(k) + "), ";
-       }
-       else
-       {
-         var1 = var1 + "var(" + string(k) + "), ";
-       }
-     }
-     if(di > 0)
-     {
-       var1 = var1 + var2;
-       var1 = var1[1..size(var1) - 2];                         // The "- 2" removes the trailer comma
-       hilf[1] = var1;
-       // SL 2006.21.04 1 The order is now block dp instead of lp
-       hilf[2] = "dp(" + string(nvars(basering) - di) + "), dp(" + string(di) + ")";
-       // SL 2006.21.04 2
-       hilf[3] = di;
-       resu[n] = hilf;
-     }
-     else
-     {
-       resu[n] = varstr(basering), ordstr(basering), 0;
-     }
-   }
-   return(resu);
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring s1 = (0, x, y), (a, b, c, d, e, f, g), lp;
-   ideal i = ea - fbg, fa + be, ec - fdg, fc + de;
-   i = std(i);
-   list l = newMaxIndependSetDp(i);
-   l;
-   i = i, g;
-   l = newMaxIndependSetDp(i);
-   l;
-
-   ring s = 0, (x, y, z), lp;
-   ideal i = z, yx;
-   list l = newMaxIndependSetDp(i);
-   l;
-}
-
-
-///////////////////////////////////////////////////////////////////////////////
-// based on prepareQuotientring
-// The order returned is now (C, dp) instead of (C, lp)
-
-static proc prepareQuotientRingDp (int nnp)
-"USAGE:   prepareQuotientRingDp(nnp); nnp int
-RETURN:  string = to define Kvar(nnp+1),...,var(nvars)[..rest ]
-NOTE:
-EXAMPLE: example prepareQuotientRingDp; shows an example
-"
-{
-  ideal @ih,@jh;
-  int npar=npars(basering);
-  int @n;
-
-  string quotring= "ring quring = ("+charstr(basering);
-  for(@n = nnp + 1; @n <= nvars(basering); @n++)
-  {
-    quotring = quotring + ", var(" + string(@n) + ")";
-    @ih = @ih + var(@n);
-  }
-
-  quotring = quotring+"),(var(1)";
-  @jh = @jh + var(1);
-  for(@n = 2; @n <= nnp; @n++)
-  {
-    quotring = quotring + ", var(" + string(@n) + ")";
-    @jh = @jh + var(@n);
-  }
-  // SL 2006-04-21 1 The order returned is now (C, dp) instead of (C, lp)
-  quotring = quotring + "), (C, dp);";
-  // SL 2006-04-21 2
-
-  return(quotring);
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring s1=(0,x),(a,b,c,d,e,f,g),lp;
-   def @Q=basering;
-   list l= prepareQuotientRingDp(3);
-   l;
-   execute(l[1]);
-   execute(l[2]);
-   basering;
-   phi;
-   setring @Q;
-}
-
-///////////////////////////////////////////////////////////////////////////////
-proc prepareAss(ideal i)
-"USAGE:   prepareAss(I); I ideal
-RETURN:  list, the radicals of the maximal dimensional components of I.
-NOTE:    Uses algorithm of Eisenbud/Huneke/Vasconcelos.
-EXAMPLE: example prepareAss; shows an example
-"
-{
-  if(attrib(basering,"global")!=1)
-  {
-    ERROR(
-      "// Not implemented for this ordering, please change to global ordering."
-    );
-  }
-  ideal j=std(i);
-  int cod=nvars(basering)-dim(j);
-  int e;
-  list er;
-  ideal ann;
-  if(homog(i)==1)
-  {
-    list re=sres(j,0);                   //the resolution
-    re=minres(re);                       //minimized resolution
-  }
-  else
-  {
-    list re=mres(i,0);
-  }
-  for(e=cod;e<=nvars(basering);e++)
-  {
-    ann=AnnExt_R(e,re);
-
-    if(nvars(basering)-dim(std(ann))==e)
-    {
-      er[size(er)+1]=equiRadical(ann);
-    }
-  }
-  return(er);
-}
-example
-{ "EXAMPLE:";  echo = 2;
-   ring  r = 0,(x,y,z),dp;
-   poly  p = z2+1;
-   poly  q = z3+2;
-   ideal i = p*q^2,y-z2;
-   list pr = prepareAss(i);
-   pr;
-}
-///////////////////////////////////////////////////////////////////////////////
-proc equidimMaxEHV(ideal i)
-"USAGE:  equidimMaxEHV(I); I ideal
-RETURN:  ideal, the equidimensional component (of maximal dimension) of I.
-NOTE:    Uses algorithm of Eisenbud, Huneke and Vasconcelos.
-EXAMPLE: example equidimMaxEHV; shows an example
-"
-{
-  if(attrib(basering,"global")!=1)
-  {
-    ERROR(
-      "// Not implemented for this ordering, please change to global ordering."
-    );
-  }
-  ideal j=groebner(i);
-  int cod=nvars(basering)-dim(j);
-  int e;
-  ideal ann;
-  if(homog(i)==1)
-  {
-    list re=sres(j,0);                   //the resolution
-    re=minres(re);                       //minimized resolution
-  }
-  else
-  {
-    list re=mres(i,0);
-  }
-  ann=AnnExt_R(cod,re);
-  return(ann);
-}
-example
-{ "EXAMPLE:";  echo = 2;
-   ring  r = 0,(x,y,z),dp;
-   ideal i=intersect(ideal(z),ideal(x,y),ideal(x2,z2),ideal(x5,y5,z5));
-   equidimMaxEHV(i);
-}
-
-proc testPrimary(list pr, ideal k)
-"USAGE:   testPrimary(pr,k); pr a list, k an ideal.
-ASSUME:  pr is the result of primdecGTZ(k) or primdecSY(k).
-RETURN:  int, 1 if the intersection of the ideals in pr is k, 0 if not
-EXAMPLE: example testPrimary; shows an example
-"
-{
-  int i;
-  pr=reconvList(pr);
-  ideal j=pr[1];
-  for (i=2;i<=size(pr)/2;i++)
-  {
-    j=intersect(j,pr[2*i-1]);
-  }
-  return(idealsEqual(j,k));
-}
-example
-{ "EXAMPLE:";  echo = 2;
-   ring  r = 32003,(x,y,z),dp;
-   poly  p = z2+1;
-   poly  q = z4+2;
-   ideal i = p^2*q^3,(y-z3)^3,(x-yz+z4)^4;
-   list pr = primdecGTZ(i);
-   testPrimary(pr,i);
-}
-
-///////////////////////////////////////////////////////////////////////////////
-proc zerodec(ideal I)
-"USAGE:   zerodec(I); I ideal
-ASSUME:  I is zero-dimensional, the characteristic of the ground field is 0
-RETURN:  list of primary ideals, the zero-dimensional decomposition of I
-NOTE:    The algorithm (of Monico), works well only for a small total number
-         of solutions (@code{vdim(std(I))} should be < 100) and without
-         parameters. In practice, it works also in large characteristic p>0
-         but may fail for small p.
-@*       If printlevel > 0 (default = 0) additional information is displayed.
-EXAMPLE: example zerodec; shows an example
-"
-{
-  if(attrib(basering,"global")!=1)
-  {
-    ERROR(
-    "// Not implemented for this ordering, please change to global ordering."
-    );
-  }
-  def R=basering;
-  poly q;
-  int j,time;
-  matrix m;
-  list re;
-  poly va=var(1);
-  ideal J=groebner(I);
-  ideal ba=kbase(J);
-  int d=vdim(J);
-  dbprint(printlevel-voice+2,"// multiplicity of ideal : "+ string(d));
-//------ compute matrix of multiplication on R/I with generic element p -----
-  int e=nvars(basering);
-  poly p=randomLast(100)[e]+random(-50,50);     //the generic element
-  matrix n[d][d];
-  time = timer;
-  for(j=2;j<=e;j++)
-  {
-    va=va*var(j);
-  }
-  for(j=1;j<=d;j++)
-  {
-    q=reduce(p*ba[j],J);
-    m=coeffs(q,ba,va);
-    n[j,1..d]=m[1..d,1];
-  }
-  dbprint(printlevel-voice+2,
-    "// time for computing multiplication matrix (with generic element) : "+
-    string(timer-time));
-//---------------- compute characteristic polynomial of matrix --------------
-  execute("ring P1=("+charstr(R)+"),T,dp;");
-  matrix n=imap(R,n);
-  time = timer;
-  poly charpol=det(n-T*freemodule(d));
-  dbprint(printlevel-voice+2,"// time for computing char poly: "+
-         string(timer-time));
-//------------------- factorize characteristic polynomial -------------------
-//check first if constant term of charpoly is != 0 (which is true for
-//sufficiently generic element)
-  if(charpol[size(charpol)]!=0)
-  {
-    time = timer;
-    list fac=factor(charpol);
-    testFactor(fac,charpol);
-    dbprint(printlevel-voice+2,"// time for factorizing char poly: "+
-            string(timer-time));
-    int f=size(fac[1]);
-//--------------------------- the irreducible case --------------------------
-    if(f==1)
-    {
-      setring R;
-      re=I;
-      return(re);
-    }
-//---------------------------- the reducible case ---------------------------
-//if f_i are the irreducible factors of charpoly, mult=ri, then <I,g_i^ri>
-//are the primary components where g_i = f_i(p). However, substituting p in
-//f_i may result in a huge object although the final result may be small.
-//Hence it is better to simultaneously reduce with I. For this we need a new
-//ring.
-    execute("ring P=("+charstr(R)+"),(T,"+varstr(R)+"),(dp(1),dp);");
-    list rfac=imap(P1,fac);
-    intvec ov=option(get);;
-    option(redSB);
-    list re1;
-    ideal new = T-imap(R,p),imap(R,J);
-    attrib(new, "isSB",1);    //we know that new is a standard basis
-    for(j=1;j<=f;j++)
-    {
-      re1[j]=reduce(rfac[1][j]^rfac[2][j],new);
-    }
-    setring R;
-    re = imap(P,re1);
-    for(j=1;j<=f;j++)
-    {
-      J=I,re[j];
-      re[j]=interred(J);
-    }
-    option(set,ov);
-    return(re);
-  }
-  else
-//------------------- choice of generic element failed -------------------
-  {
-    dbprint(printlevel-voice+2,"// try new generic element!");
-    setring R;
-    return(zerodec(I));
-  }
-}
-example
-{ "EXAMPLE:";  echo = 2;
-   ring r  = 0,(x,y),dp;
-   ideal i = x2-2,y2-2;
-   list pr = zerodec(i);
-   pr;
-}
-///////////////////////////////////////////////////////////////////////////////
-static proc newDecompStep(ideal i, list #)
-"USAGE:  newDecompStep(i); i ideal  (for primary decomposition)
-         newDecompStep(i,1);        (for the associated primes of dimension of i)
-         newDecompStep(i,2);        (for the minimal associated primes)
-         newDecompStep(i,3);        (for the absolute primary decomposition (not tested!))
-         "oneIndep";        (for using only one max indep set)
-         "intersect";        (returns alse the intersection of the components founded)
-
-RETURN:  list = list of primary ideals and their associated primes
-         (at even positions in the list)
-         (resp. a list of the minimal associated primes)
-NOTE:    Algorithm of Gianni/Trager/Zacharias
-EXAMPLE: example newDecompStep; shows an example
-"
-{
-  intvec op,@vv;
-  def  @P = basering;
-  list primary,indep,ltras;
-  intvec @vh,isat,@w;
-  int @wr,@k,@n,@m,@n1,@n2,@n3,homo,seri,keepdi,abspri,ab,nn;
-  ideal peek=i;
-  ideal ser,tras;
-  list data;
-  list result;
-  intvec @hilb;
-  int isS=(attrib(i,"isSB")==1);
-
-  // Debug
-  dbprint(printlevel - voice, "newDecompStep, v2.0");
-
-  string indepOption = "allIndep";
-  string intersectOption = "noIntersect";
-
-  if(size(#)>0)
-  {
-    int count = 1;
-    if(typeof(#[count]) == "string")
-    {
-      if ((#[count] == "oneIndep") or (#[count] == "allIndep"))
-      {
-        indepOption = #[count];
-        count++;
-      }
-    }
-    if(typeof(#[count]) == "string")
-    {
-      if ((#[count] == "intersect") or (#[count] == "noIntersect"))
-      {
-        intersectOption = #[count];
-        count++;
-      }
-    }
-    if((typeof(#[count]) == "int") or (typeof(#[count]) == "number"))
-    {
-      if ((#[count]==1)||(#[count]==2)||(#[count]==3))
-      {
-        @wr=#[count];
-        if(@wr==3){abspri = 1; @wr = 0;}
-        count++;
-      }
-    }
-    if(size(#)>count)
-    {
-      seri=1;
-      peek=#[count + 1];
-      ser=#[count + 2];
-    }
-  }
-  if(abspri)
-  {
-    list absprimary,abskeep,absprimarytmp,abskeeptmp;
-  }
-  homo=homog(i);
-  if(homo==1)
-  {
-    if(attrib(i,"isSB")!=1)
-    {
-      //ltras=mstd(i);
-      tras=groebner(i);
-      ltras=tras,tras;
-      attrib(ltras[1],"isSB",1);
-    }
-    else
-    {
-      ltras=i,i;
-      attrib(ltras[1],"isSB",1);
-    }
-    tras = ltras[1];
-    attrib(tras,"isSB",1);
-    if(dim(tras)==0)
-    {
-      primary[1]=ltras[2];
-      primary[2]=maxideal(1);
-      if(@wr>0)
-      {
-        list l;
-        l[2]=maxideal(1);
-        l[1]=maxideal(1);
-        if (intersectOption == "intersect")
-        {
-          return(list(l, maxideal(1)));
-        }
-        else
-        {
-          return(l);
-        }
-      }
-      if (intersectOption == "intersect")
-      {
-        return(list(primary, primary[1]));
-      }
-      else
-      {
-        return(primary);
-      }
-    }
-    for(@n=1;@n<=nvars(basering);@n++)
-    {
-      @w[@n]=ord(var(@n));
-    }
-    @hilb=hilb(tras,1,@w);
-    intvec keephilb=@hilb;
-  }
-
-  //----------------------------------------------------------------
-  //i is the zero-ideal
-  //----------------------------------------------------------------
-
-  if(size(i)==0)
-  {
-    primary=i,i;
-    if (intersectOption == "intersect")
-    {
-      return(list(primary, i));
-    }
-    else
-    {
-      return(primary);
-    }
-  }
-
-  //----------------------------------------------------------------
-  //pass to the lexicographical ordering and compute a standardbasis
-  //----------------------------------------------------------------
-
-  int lp=islp();
-
-  execute("ring gnir = ("+charstr(basering)+"),("+varstr(basering)+"),(C,lp);");
-  op=option(get);
-  option(redSB);
-
-  ideal ser=fetch(@P,ser);
-  if(homo==1)
-  {
-    if(!lp)
-    {
-      ideal @j=std(fetch(@P,i),@hilb,@w);
-    }
-    else
-    {
-      ideal @j=fetch(@P,tras);
-      attrib(@j,"isSB",1);
-    }
-  }
-  else
-  {
-    if(lp&&isS)
-    {
-      ideal @j=fetch(@P,i);
-      attrib(@j,"isSB",1);
-    }
-    else
-    {
-      ideal @j=groebner(fetch(@P,i));
-    }
-  }
-  option(set,op);
-  if(seri==1)
-  {
-    ideal peek=fetch(@P,peek);
-    attrib(peek,"isSB",1);
-  }
-  else
-  {
-    ideal peek=@j;
-  }
-  if((size(ser)==0)&&(!abspri))
-  {
-    ideal fried;
-    @n=size(@j);
-    for(@k=1;@k<=@n;@k++)
-    {
-      if(deg(lead(@j[@k]))==1)
-      {
-        fried[size(fried)+1]=@j[@k];
-        @j[@k]=0;
-      }
-    }
-    if(size(fried)==nvars(basering))
-    {
-      setring @P;
-      primary[1]=i;
-      primary[2]=i;
-      if (intersectOption == "intersect")
-      {
-        return(list(primary, i));
-      }
-      else
-      {
-        return(primary);
-      }
-    }
-    if(size(fried)>0)
-    {
-      string newva;
-      string newma;
-      for(@k=1;@k<=nvars(basering);@k++)
-      {
-        @n1=0;
-        for(@n=1;@n<=size(fried);@n++)
-        {
-          if(leadmonom(fried[@n])==var(@k))
-          {
-            @n1=1;
-            break;
-          }
-        }
-        if(@n1==0)
-        {
-          newva=newva+string(var(@k))+",";
-          newma=newma+string(var(@k))+",";
-        }
-        else
-        {
-          newma=newma+string(0)+",";
-        }
-      }
-      newva[size(newva)]=")";
-      newma[size(newma)]=";";
-      execute("ring @deirf=("+charstr(gnir)+"),("+newva+",lp;");
-      execute("map @kappa=gnir,"+newma);
-      ideal @j= @kappa(@j);
-      @j=simplify(@j, 2);
-      attrib(@j,"isSB",1);
-      result = newDecompStep(@j, indepOption, intersectOption, @wr);
-      if (intersectOption == "intersect")
-      {
-        list pr = result[1];
-        ideal intersection = result[2];
-      }
-      else
-      {
-        list pr = result;
-      }
-
-      setring gnir;
-      list pr=imap(@deirf,pr);
-      for(@k=1;@k<=size(pr);@k++)
-      {
-        @j=pr[@k]+fried;
-        pr[@k]=@j;
-      }
-      if (intersectOption == "intersect")
-      {
-        ideal intersection = imap(@deirf, intersection);
-        @j = intersection + fried;
-        intersection = @j;
-      }
-      setring @P;
-      if (intersectOption == "intersect")
-      {
-        return(list(imap(gnir,pr), imap(gnir,intersection)));
-      }
-      else
-      {
-        return(imap(gnir,pr));
-      }
-    }
-  }
-  //----------------------------------------------------------------
-  //j is the ring
-  //----------------------------------------------------------------
-
-  if (dim(@j)==-1)
-  {
-    setring @P;
-    primary=ideal(1),ideal(1);
-    if (intersectOption == "intersect")
-    {
-      return(list(primary, ideal(1)));
-    }
-    else
-    {
-      return(primary);
-    }
-  }
-
-  //----------------------------------------------------------------
-  //  the case of one variable
-  //----------------------------------------------------------------
-
-  if(nvars(basering)==1)
-  {
-    list fac=factor(@j[1]);
-    list gprimary;
-    poly generator;
-    ideal gIntersection;
-    for(@k=1;@k<=size(fac[1]);@k++)
-    {
-      if(@wr==0)
-      {
-        gprimary[2*@k-1]=ideal(fac[1][@k]^fac[2][@k]);
-        gprimary[2*@k]=ideal(fac[1][@k]);
-      }
-      else
-      {
-        gprimary[2*@k-1]=ideal(fac[1][@k]);
-        gprimary[2*@k]=ideal(fac[1][@k]);
-      }
-      if (intersectOption == "intersect")
-      {
-        generator = generator * fac[1][@k];
-      }
-    }
-    if (intersectOption == "intersect")
-    {
-      gIntersection = generator;
-    }
-    setring @P;
-    primary=fetch(gnir,gprimary);
-    if (intersectOption == "intersect")
-    {
-      ideal intersection = fetch(gnir,gIntersection);
-    }
-
-//HIER
-    if(abspri)
-    {
-      list resu,tempo;
-      string absotto;
-      for(ab=1;ab<=size(primary)/2;ab++)
-      {
-        absotto= absFactorize(primary[2*ab][1],77);
-        tempo=primary[2*ab-1],primary[2*ab],absotto,string(var(nvars(basering)));
-        resu[ab]=tempo;
-      }
-      primary=resu;
-      intersection = 1;
-      for(ab=1;ab<=size(primary);ab++)
-      {
-        intersection = intersect(intersection, primary[ab][2]);
-      }
-    }
-    if (intersectOption == "intersect")
-    {
-      return(list(primary, intersection));
-    }
-    else
-    {
-      return(primary);
-    }
-  }
-
- //------------------------------------------------------------------
- //the zero-dimensional case
- //------------------------------------------------------------------
-  if (dim(@j)==0)
-  {
-    op=option(get);
-    option(redSB);
-    list gprimary= newZero_decomp(@j,ser,@wr);
-
-    setring @P;
-    primary=fetch(gnir,gprimary);
-
-    if(size(ser)>0)
-    {
-      primary=cleanPrimary(primary);
-    }
-//HIER
-    if(abspri)
-    {
-      list resu,tempo;
-      string absotto;
-      for(ab=1;ab<=size(primary)/2;ab++)
-      {
-        absotto= absFactorize(primary[2*ab][1],77);
-        tempo=primary[2*ab-1],primary[2*ab],absotto,string(var(nvars(basering)));
-        resu[ab]=tempo;
-      }
-      primary=resu;
-    }
-    if (intersectOption == "intersect")
-    {
-      return(list(primary, fetch(gnir,@j)));
-    }
-    else
-    {
-      return(primary);
-    }
-  }
-
-  poly @gs,@gh,@p;
-  string @va,quotring;
-  list quprimary,htprimary,collectprimary,lsau,lnew,allindep,restindep;
-  ideal @h;
-  int jdim=dim(@j);
-  list fett;
-  int lauf,di,newtest;
-  //------------------------------------------------------------------
-  //search for a maximal independent set indep,i.e.
-  //look for subring such that the intersection with the ideal is zero
-  //j intersected with K[var(indep[3]+1),...,var(nvar] is zero,
-  //indep[1] is the new varstring and indep[2] the string for block-ordering
-  //------------------------------------------------------------------
-  if(@wr!=1)
-  {
-    allindep = newMaxIndependSetLp(@j, indepOption);
-    for(@m=1;@m<=size(allindep);@m++)
-    {
-      if(allindep[@m][3]==jdim)
-      {
-        di++;
-        indep[di]=allindep[@m];
-      }
-      else
-      {
-        lauf++;
-        restindep[lauf]=allindep[@m];
-      }
-    }
-  }
-  else
-  {
-    indep = newMaxIndependSetLp(@j, indepOption);
-  }
-
-  ideal jkeep=@j;
-  if(ordstr(@P)[1]=="w")
-  {
-    execute("ring @Phelp=("+charstr(gnir)+"),("+varstr(gnir)+"),("+ordstr(@P)+");");
-  }
-  else
-  {
-    execute( "ring @Phelp=("+charstr(gnir)+"),("+varstr(gnir)+"),(C,dp);");
-  }
-
-  if(homo==1)
-  {
-    if((ordstr(@P)[3]=="d")||(ordstr(@P)[1]=="d")||(ordstr(@P)[1]=="w")
-       ||(ordstr(@P)[3]=="w"))
-    {
-      ideal jwork=imap(@P,tras);
-      attrib(jwork,"isSB",1);
-    }
-    else
-    {
-      ideal jwork=std(imap(gnir,@j),@hilb,@w);
-    }
-  }
-  else
-  {
-    ideal jwork=groebner(imap(gnir,@j));
-  }
-  list hquprimary;
-  poly @p,@q;
-  ideal @h,fac,ser;
-//Aenderung================
-  ideal @Ptest=1;
-//=========================
-  di=dim(jwork);
-  keepdi=di;
-
-  ser = 1;
-
-  setring gnir;
-  for(@m=1; @m<=size(indep); @m++)
-  {
-    data[1] = indep[@m];
-    result = newReduction(@j, ser, @hilb, @w, jdim, abspri, @wr, data);
-    quprimary = quprimary + result[1];
-    if(abspri)
-    {
-      absprimary = absprimary + result[2];
-      abskeep = abskeep + result[3];
-    }
-    @h = result[5];
-    ser = result[4];
-    if(size(@h)>0)
-    {
-      //---------------------------------------------------------------
-      //we change to @Phelp to have the ordering dp for saturation
-      //---------------------------------------------------------------
-
-      setring @Phelp;
-      @h=imap(gnir,@h);
-//Aenderung==================================
-      if(defined(@LL)){kill @LL;}
-      list @LL=minSat(jwork,@h);
-      @Ptest=intersect(@Ptest,@LL[1]);
-      ser = intersect(ser, @LL[1]);
-//===========================================
-
-      if(@wr!=1)
-      {
-//Aenderung==================================
-        @q=@LL[2];
-//===========================================
-        //@q=minSat(jwork,@h)[2];
-      }
-      else
-      {
-        fac=ideal(0);
-        for(lauf=1;lauf<=ncols(@h);lauf++)
-        {
-          if(deg(@h[lauf])>0)
-          {
-            fac=fac+factorize(@h[lauf],1);
-          }
-        }
-        fac=simplify(fac,6);
-        @q=1;
-        for(lauf=1;lauf<=size(fac);lauf++)
-        {
-          @q=@q*fac[lauf];
-        }
-      }
-      jwork = std(jwork,@q);
-      keepdi = dim(jwork);
-      if(keepdi < di)
-      {
-        setring gnir;
-        @j = imap(@Phelp, jwork);
-        ser = imap(@Phelp, ser);
-        break;
-      }
-      if(homo == 1)
-      {
-        @hilb = hilb(jwork, 1, @w);
-      }
-
-      setring gnir;
-      ser = imap(@Phelp, ser);
-      @j = imap(@Phelp, jwork);
-    }
-  }
-
-  if((size(quprimary)==0)&&(@wr==1))
-  {
-    @j=ideal(1);
-    quprimary[1]=ideal(1);
-    quprimary[2]=ideal(1);
-  }
-  if((size(quprimary)==0))
-  {
-    keepdi = di - 1;
-    quprimary[1]=ideal(1);
-    quprimary[2]=ideal(1);
-  }
-  //---------------------------------------------------------------
-  //notice that j=sat(j,gh) intersected with (j,gh^n)
-  //we finished with sat(j,gh) and have to start with (j,gh^n)
-  //---------------------------------------------------------------
-  if((deg(@j[1])!=0)&&(@wr!=1))
-  {
-    if(size(quprimary)>0)
-    {
-      setring @Phelp;
-      ser=imap(gnir,ser);
-
-      hquprimary=imap(gnir,quprimary);
-      if(@wr==0)
-      {
-//Aenderung====================================================
-//HIER STATT DURCHSCHNITT SATURIEREN!
-        ideal htest=@Ptest;
-/*
-        ideal htest=hquprimary[1];
-        for (@n1=2;@n1<=size(hquprimary)/2;@n1++)
-        {
-          htest=intersect(htest,hquprimary[2*@n1-1]);
-        }
-*/
-//=============================================================
-      }
-      else
-      {
-        ideal htest=hquprimary[2];
-
-        for (@n1=2;@n1<=size(hquprimary)/2;@n1++)
-        {
-          htest=intersect(htest,hquprimary[2*@n1]);
-        }
-      }
-
-      if(size(ser)>0)
-      {
-        ser=intersect(htest,ser);
-      }
-      else
-      {
-        ser=htest;
-      }
-      setring gnir;
-      ser=imap(@Phelp,ser);
-    }
-    if(size(reduce(ser,peek,1))!=0)
-    {
-      for(@m=1;@m<=size(restindep);@m++)
-      {
-        // if(restindep[@m][3]>=keepdi)
-        // {
-        isat=0;
-        @n2=0;
-
-        if(restindep[@m][1]==varstr(basering))
-        //the good case, nothing to do, just to have the same notations
-        //change the ring
-        {
-          execute("ring gnir1 = ("+charstr(basering)+"),("+
-                varstr(basering)+"),("+ordstr(basering)+");");
-          ideal @j=fetch(gnir,jkeep);
-          attrib(@j,"isSB",1);
-        }
-        else
-        {
-          @va=string(maxideal(1));
-          execute("ring gnir1 = ("+charstr(basering)+"),("+
-                      restindep[@m][1]+"),(" +restindep[@m][2]+");");
-          execute("map phi=gnir,"+@va+";");
-          op=option(get);
-          option(redSB);
-          if(homo==1)
-          {
-            ideal @j=std(phi(jkeep),keephilb,@w);
-          }
-          else
-          {
-            ideal @j=groebner(phi(jkeep));
-          }
-          ideal ser=phi(ser);
-          option(set,op);
-        }
-
-        for (lauf=1;lauf<=size(@j);lauf++)
-        {
-          fett[lauf]=size(@j[lauf]);
-        }
-        //------------------------------------------------------------------
-        //we have now the following situation:
-        //j intersected with K[var(nnp+1),..,var(nva)] is zero so we may
-        //pass to this quotientring, j is their still a standardbasis, the
-        //leading coefficients of the polynomials  there (polynomials in
-        //K[var(nnp+1),..,var(nva)]) are collected in the list h,
-        //we need their ggt, gh, because of the following:
-        //let (j:gh^n)=(j:gh^infinity) then
-        //j*K(var(nnp+1),..,var(nva))[..the rest..]
-        //intersected with K[var(1),...,var(nva)] is (j:gh^n)
-        //on the other hand j=(j,gh^n) intersected with (j:gh^n)
-
-        //------------------------------------------------------------------
-
-        //the arrangement for the quotientring
-        // K(var(nnp+1),..,var(nva))[..the rest..]
-        //and the map phi:K[var(1),...,var(nva)] ---->
-        //--->K(var(nnpr+1),..,var(nva))[..the rest..]
-        //------------------------------------------------------------------
-
-        quotring=prepareQuotientring(nvars(basering)-restindep[@m][3]);
-
-        //------------------------------------------------------------------
-        //we pass to the quotientring  K(var(nnp+1),..,var(nva))[..rest..]
-        //------------------------------------------------------------------
-
-        execute(quotring);
-
-        // @j considered in the quotientring
-        ideal @j=imap(gnir1,@j);
-        ideal ser=imap(gnir1,ser);
-
-        kill gnir1;
-
-        //j is a standardbasis in the quotientring but usually not minimal
-        //here it becomes minimal
-        @j=clearSB(@j,fett);
-        attrib(@j,"isSB",1);
-
-        //we need later ggt(h[1],...)=gh for saturation
-        ideal @h;
-        for(@n=1;@n<=size(@j);@n++)
-        {
-          @h[@n]=leadcoef(@j[@n]);
-        }
-        //the primary decomposition of j*K(var(nnp+1),..,var(nva))[..rest..]
-
-        op=option(get);
-        option(redSB);
-        list uprimary= newZero_decomp(@j,ser,@wr);
-//HIER
-        if(abspri)
-        {
-          ideal II;
-          ideal jmap;
-          map sigma;
-          nn=nvars(basering);
-          map invsigma=basering,maxideal(1);
-          for(ab=1;ab<=size(uprimary)/2;ab++)
-          {
-            II=uprimary[2*ab];
-            attrib(II,"isSB",1);
-            if(deg(II[1])!=vdim(II))
-            {
-              jmap=randomLast(50);
-              sigma=basering,jmap;
-              jmap[nn]=2*var(nn)-jmap[nn];
-              invsigma=basering,jmap;
-              II=groebner(sigma(II));
-            }
-            absprimarytmp[ab]= absFactorize(II[1],77);
-            II=var(nn);
-            abskeeptmp[ab]=string(invsigma(II));
-            invsigma=basering,maxideal(1);
-          }
-        }
-        option(set,op);
-
-        //we need the intersection of the ideals in the list quprimary with
-        //the polynomialring, i.e. let q=(f1,...,fr) in the quotientring
-        //such an ideal but fi polynomials, then the intersection of q with
-        //the polynomialring is the saturation of the ideal generated by
-        //f1,...,fr with respect toh which is the lcm of the leading
-        //coefficients of the fi considered in the quotientring:
-        //this is coded in saturn
-
-        list saturn;
-        ideal hpl;
-
-        for(@n=1;@n<=size(uprimary);@n++)
-        {
-          hpl=0;
-          for(@n1=1;@n1<=size(uprimary[@n]);@n1++)
-          {
-            hpl=hpl,leadcoef(uprimary[@n][@n1]);
-          }
-          saturn[@n]=hpl;
-        }
-        //------------------------------------------------------------------
-        //we leave  the quotientring   K(var(nnp+1),..,var(nva))[..rest..]
-        //back to the polynomialring
-        //------------------------------------------------------------------
-        setring gnir;
-        collectprimary=imap(quring,uprimary);
-        lsau=imap(quring,saturn);
-        @h=imap(quring,@h);
-
-        kill quring;
-
-        @n2=size(quprimary);
-//================NEU=========================================
-        if(deg(quprimary[1][1])<=0){ @n2=0; }
-//============================================================
-
-        @n3=@n2;
-
-        for(@n1=1;@n1<=size(collectprimary)/2;@n1++)
-        {
-          if(deg(collectprimary[2*@n1][1])>0)
-          {
-            @n2++;
-            quprimary[@n2]=collectprimary[2*@n1-1];
-            lnew[@n2]=lsau[2*@n1-1];
-            @n2++;
-            lnew[@n2]=lsau[2*@n1];
-            quprimary[@n2]=collectprimary[2*@n1];
-            if(abspri)
-            {
-              absprimary[@n2/2]=absprimarytmp[@n1];
-              abskeep[@n2/2]=abskeeptmp[@n1];
-            }
-          }
-        }
-
-
-        //here the intersection with the polynomialring
-        //mentioned above is really computed
-
-        for(@n=@n3/2+1;@n<=@n2/2;@n++)
-        {
-          if(specialIdealsEqual(quprimary[2*@n-1],quprimary[2*@n]))
-          {
-            quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
-            quprimary[2*@n]=quprimary[2*@n-1];
-          }
-          else
-          {
-            if(@wr==0)
-            {
-              quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
-            }
-            quprimary[2*@n]=sat2(quprimary[2*@n],lnew[2*@n])[1];
-          }
-        }
-        if(@n2>=@n3+2)
-        {
-          setring @Phelp;
-          ser=imap(gnir,ser);
-          hquprimary=imap(gnir,quprimary);
-          for(@n=@n3/2+1;@n<=@n2/2;@n++)
-          {
-            if(@wr==0)
-            {
-              ser=intersect(ser,hquprimary[2*@n-1]);
-            }
-            else
-            {
-              ser=intersect(ser,hquprimary[2*@n]);
-            }
-          }
-          setring gnir;
-          ser=imap(@Phelp,ser);
-        }
-
-        // }
-      }
-//HIER
-      if(abspri)
-      {
-        list resu,tempo;
-        for(ab=1;ab<=size(quprimary)/2;ab++)
-        {
-          if (deg(quprimary[2*ab][1])!=0)
-          {
-            tempo=quprimary[2*ab-1],quprimary[2*ab],
-                         absprimary[ab],abskeep[ab];
-            resu[ab]=tempo;
-          }
-        }
-        quprimary=resu;
-        @wr=3;
-      }
-      if(size(reduce(ser,peek,1))!=0)
-      {
-        if(@wr>0)
-        {
-          // The following line was dropped to avoid the recursion step:
-          //htprimary=newDecompStep(@j,@wr,peek,ser);
-          htprimary = list();
-        }
-        else
-        {
-          // The following line was dropped to avoid the recursion step:
-          //htprimary=newDecompStep(@j,peek,ser);
-          htprimary = list();
-        }
-        // here we collect now both results primary(sat(j,gh))
-        // and primary(j,gh^n)
-        @n=size(quprimary);
-        if (deg(quprimary[1][1])<=0) { @n=0; }
-        for (@k=1;@k<=size(htprimary);@k++)
-        {
-          quprimary[@n+@k]=htprimary[@k];
-        }
-      }
-    }
-  }
-  else
-  {
-    if(abspri)
-    {
-      list resu,tempo;
-      for(ab=1;ab<=size(quprimary)/2;ab++)
-      {
-        tempo=quprimary[2*ab-1],quprimary[2*ab],
-                   absprimary[ab],abskeep[ab];
-        resu[ab]=tempo;
-      }
-      quprimary=resu;
-    }
-  }
-  //---------------------------------------------------------------------------
-  //back to the ring we started with
-  //the final result: primary
-  //---------------------------------------------------------------------------
-
-  setring @P;
-  primary=imap(gnir,quprimary);
-
-  if (intersectOption == "intersect")
-  {
-    return(list(primary, imap(gnir, ser)));
-  }
-  else
-  {
-    return(primary);
-  }
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring  r = 32003,(x,y,z),lp;
-   poly  p = z2+1;
-   poly  q = z4+2;
-   ideal i = p^2*q^3,(y-z3)^3,(x-yz+z4)^4;
-   list pr= newDecompStep(i);
-   pr;
-   testPrimary( pr, i);
-}
-
-// This was part of proc decomp.
-// In proc newDecompStep, used for the computation of the minimal associated primes,
-// this part was separated as a soubrutine to make the code more clear.
-// Also, since the reduction is performed twice in proc newDecompStep, it should use both times this routine.
-// This is not yet implemented, since the reduction is not exactly the same and some changes should be made.
-static proc newReduction(ideal @j, ideal ser, intvec @hilb, intvec @w, int jdim, int abspri, int @wr, list data)
-{
-  string @va;
-  string quotring;
-  intvec op;
-  intvec @vv;
-  def gnir = basering;
-  ideal isat=0;
-  int @n;
-  int @n1 = 0;
-  int @n2 = 0;
-  int @n3 = 0;
-  int homo = homog(@j);
-  int lauf;
-  int @k;
-  list fett;
-  int keepdi;
-  list collectprimary;
-  list lsau;
-  list lnew;
-  ideal @h;
-
-  list indepInfo = data[1];
-  list quprimary = list();
-
-  //if(abspri)
-  //{
-     int ab;
-     list absprimarytmp,abskeeptmp;
-     list absprimary, abskeep;
-  //}
-  // Debug
-  dbprint(printlevel - voice, "newReduction, v2.0");
-
-  if((indepInfo[1]==varstr(basering)))  // &&(@m==1)
-  //this is the good case, nothing to do, just to have the same notations
-  //change the ring
-  {
-    execute("ring gnir1 = ("+charstr(basering)+"),("+varstr(basering)+"),("
-                              +ordstr(basering)+");");
-    ideal @j = fetch(gnir, @j);
-    attrib(@j,"isSB",1);
-    ideal ser = fetch(gnir, ser);
-  }
-  else
-  {
-    @va=string(maxideal(1));
-//Aenderung==============
-    //if(@m==1)
-    //{
-    //  @j=fetch(@P,i);
-    //}
-//=======================
-    execute("ring gnir1 = ("+charstr(basering)+"),("+indepInfo[1]+"),("
-                              +indepInfo[2]+");");
-    execute("map phi=gnir,"+@va+";");
-    op=option(get);
-    option(redSB);
-    if(homo==1)
-    {
-      ideal @j=std(phi(@j),@hilb,@w);
-    }
-    else
-    {
-      ideal @j=groebner(phi(@j));
-    }
-    ideal ser=phi(ser);
-
-    option(set,op);
-  }
-  if((deg(@j[1])==0)||(dim(@j)<jdim))
-  {
-    setring gnir;
-    break;
-  }
-  for (lauf=1;lauf<=size(@j);lauf++)
-  {
-    fett[lauf]=size(@j[lauf]);
-  }
-  //------------------------------------------------------------------------
-  //we have now the following situation:
-  //j intersected with K[var(nnp+1),..,var(nva)] is zero so we may pass
-  //to this quotientring, j is their still a standardbasis, the
-  //leading coefficients of the polynomials  there (polynomials in
-  //K[var(nnp+1),..,var(nva)]) are collected in the list h,
-  //we need their ggt, gh, because of the following: let
-  //(j:gh^n)=(j:gh^infinity) then j*K(var(nnp+1),..,var(nva))[..the rest..]
-  //intersected with K[var(1),...,var(nva)] is (j:gh^n)
-  //on the other hand j=(j,gh^n) intersected with (j:gh^n)
-
-  //------------------------------------------------------------------------
-
-  //arrangement for quotientring K(var(nnp+1),..,var(nva))[..the rest..] and
-  //map phi:K[var(1),...,var(nva)] --->K(var(nnpr+1),..,var(nva))[..rest..]
-  //------------------------------------------------------------------------
-
-  quotring=prepareQuotientring(nvars(basering)-indepInfo[3]);
-
-  //---------------------------------------------------------------------
-  //we pass to the quotientring   K(var(nnp+1),..,var(nva))[..the rest..]
-  //---------------------------------------------------------------------
-
-  ideal @jj=lead(@j);               //!! vorn vereinbaren
-  execute(quotring);
-
-  ideal @jj=imap(gnir1,@jj);
-  @vv=clearSBNeu(@jj,fett);  //!! vorn vereinbaren
-  setring gnir1;
-  @k=size(@j);
-  for (lauf=1;lauf<=@k;lauf++)
-  {
-    if(@vv[lauf]==1)
-    {
-      @j[lauf]=0;
-    }
-  }
-  @j=simplify(@j,2);
-  setring quring;
-  // @j considered in the quotientring
-  ideal @j=imap(gnir1,@j);
-
-  ideal ser=imap(gnir1,ser);
-
-  kill gnir1;
-
-  //j is a standardbasis in the quotientring but usually not minimal
-  //here it becomes minimal
-
-  attrib(@j,"isSB",1);
-
-  //we need later ggt(h[1],...)=gh for saturation
-  ideal @h;
-  if(deg(@j[1])>0)
-  {
-    for(@n=1;@n<=size(@j);@n++)
-    {
-      @h[@n]=leadcoef(@j[@n]);
-    }
-    //the primary decomposition of j*K(var(nnp+1),..,var(nva))[..the rest..]
-    op=option(get);
-    option(redSB);
-
-    int zeroMinAss = @wr;
-    if (@wr == 2) {zeroMinAss = 1;}
-    list uprimary= newZero_decomp(@j, ser, zeroMinAss);
-
-//HIER
-    if(abspri)
-    {
-      ideal II;
-      ideal jmap;
-      map sigma;
-      nn=nvars(basering);
-      map invsigma=basering,maxideal(1);
-      for(ab=1;ab<=size(uprimary)/2;ab++)
-      {
-        II=uprimary[2*ab];
-        attrib(II,"isSB",1);
-        if(deg(II[1])!=vdim(II))
-        {
-          jmap=randomLast(50);
-          sigma=basering,jmap;
-          jmap[nn]=2*var(nn)-jmap[nn];
-          invsigma=basering,jmap;
-          II=groebner(sigma(II));
-        }
-        absprimarytmp[ab]= absFactorize(II[1],77);
-        II=var(nn);
-        abskeeptmp[ab]=string(invsigma(II));
-        invsigma=basering,maxideal(1);
-      }
-    }
-    option(set,op);
-  }
-  else
-  {
-    list uprimary;
-    uprimary[1]=ideal(1);
-    uprimary[2]=ideal(1);
-  }
-  //we need the intersection of the ideals in the list quprimary with the
-  //polynomialring, i.e. let q=(f1,...,fr) in the quotientring such an ideal
-  //but fi polynomials, then the intersection of q with the polynomialring
-  //is the saturation of the ideal generated by f1,...,fr with respect to
-  //h which is the lcm of the leading coefficients of the fi considered in
-  //in the quotientring: this is coded in saturn
-
-  list saturn;
-  ideal hpl;
-
-  for(@n=1;@n<=size(uprimary);@n++)
-  {
-    uprimary[@n]=interred(uprimary[@n]); // temporary fix
-    hpl=0;
-    for(@n1=1;@n1<=size(uprimary[@n]);@n1++)
-    {
-      hpl=hpl,leadcoef(uprimary[@n][@n1]);
-    }
-    saturn[@n]=hpl;
-  }
-
-  //--------------------------------------------------------------------
-  //we leave  the quotientring   K(var(nnp+1),..,var(nva))[..the rest..]
-  //back to the polynomialring
-  //---------------------------------------------------------------------
-  setring gnir;
-
-  collectprimary=imap(quring,uprimary);
-  lsau=imap(quring,saturn);
-  @h=imap(quring,@h);
-
-  kill quring;
-
-  @n2=size(quprimary);
-  @n3=@n2;
-
-  for(@n1=1;@n1<=size(collectprimary)/2;@n1++)
-  {
-    if(deg(collectprimary[2*@n1][1])>0)
-    {
-      @n2++;
-      quprimary[@n2]=collectprimary[2*@n1-1];
-      lnew[@n2]=lsau[2*@n1-1];
-      @n2++;
-      lnew[@n2]=lsau[2*@n1];
-      quprimary[@n2]=collectprimary[2*@n1];
-      if(abspri)
-      {
-        absprimary[@n2/2]=absprimarytmp[@n1];
-        abskeep[@n2/2]=abskeeptmp[@n1];
-      }
-    }
-  }
-
-  //here the intersection with the polynomialring
-  //mentioned above is really computed
-  for(@n=@n3/2+1;@n<=@n2/2;@n++)
-  {
-    if(specialIdealsEqual(quprimary[2*@n-1],quprimary[2*@n]))
-    {
-      quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
-      quprimary[2*@n]=quprimary[2*@n-1];
-    }
-    else
-    {
-      if(@wr==0)
-      {
-        quprimary[2*@n-1]=sat2(quprimary[2*@n-1],lnew[2*@n-1])[1];
-      }
-      quprimary[2*@n]=sat2(quprimary[2*@n],lnew[2*@n])[1];
-    }
-  }
-
-  return(quprimary, absprimary, abskeep, ser, @h);
-}
-
-
-///////////////////////////////////////////////////////////////////////////////
-// Based on minAssGTZ
-
-proc minAss(ideal i,list #)
-"USAGE:   minAss(I[, l]); i ideal, l list (optional) of parameters, same as minAssGTZ
-RETURN:  a list, the minimal associated prime ideals of I.
-NOTE:    Designed for characteristic 0, works also in char k > 0 based
-         on an algorithm of Yokoyama
-EXAMPLE: example minAss; shows an example
-"
-{
-  return(minAssGTZ(i,#));
-}
-example
-{ "EXAMPLE:";  echo = 2;
-   ring  r = 0, (x, y, z), dp;
-   poly  p = z2 + 1;
-   poly  q = z3 + 2;
-   ideal i = p * q^2, y - z2;
-   list pr = minAss(i);
-   pr;
-}
-
-
-///////////////////////////////////////////////////////////////////////////////
-//
-// Computes the minimal associated primes of I via Laplagne algorithm,
-// using primary decomposition in the zero dimensional case.
-// For reduction to the zerodimensional case, it uses the procedure
-// decomp, with some modifications to avoid the recursion.
-//
-
-static proc minAssSL(ideal I)
-// Input = I, ideal
-// Output = primaryDec where primaryDec is the list of the minimal
-// associated primes and the primary components corresponding to these primes.
-{
-  ideal P = 1;
-  list pd = list();
-  int k;
-  int stop = 0;
-  list primaryDec = list();
-
-  while (stop == 0)
-  {
-    // Debug
-    dbprint(printlevel - voice, "// We call minAssSLIteration to find new prime ideals!");
-    pd = minAssSLIteration(I, P);
-    // Debug
-    dbprint(printlevel - voice, "// Output of minAssSLIteration:");
-    dbprint(printlevel - voice, pd);
-    if (size(pd[1]) > 0)
-    {
-      primaryDec = primaryDec + pd[1];
-      // Debug
-      dbprint(printlevel - voice, "// We intersect the prime ideals obtained.");
-      P = intersect(P, pd[2]);
-      // Debug
-      dbprint(printlevel - voice, "// Intersection finished.");
-    }
-    else
-    {
-      stop = 1;
-    }
-  }
-
-  // Returns only the primary components, not the radical.
-  return(primaryDec);
-}
-
-///////////////////////////////////////////////////////////////////////////////
-// Given an ideal I and an ideal P (intersection of some minimal prime ideals
-// associated to I), it calculates new minimal prime ideals associated to I
-// which were not used to calculate P.
-// This version uses Primary Decomposition in the zerodimensional case.
-static proc minAssSLIteration(ideal I, ideal P);
-{
-  int k = 1;
-  int good  = 0;
-  list primaryDec = list();
-  // Debug
-  dbprint (printlevel-voice, "// We search for an element in P - sqrt(I).");
-  while ((k <= size(P)) and (good == 0))
-  {
-    good = 1 - rad_con(P[k], I);
-    k++;
-  }
-  k--;
-  if (good == 0)
-  {
-    // Debug
-    dbprint (printlevel - voice, "// No element was found, P = sqrt(I).");
-    return (list(primaryDec, ideal(0)));
-  }
-  // Debug
-  dbprint (printlevel - voice, "// We found h = ", P[k]);
-  dbprint (printlevel - voice, "// We calculate the saturation of I with respect to the element just founded.");
-  ideal J = sat(I, P[k])[1];
-
-  // Uses decomp from primdec, modified to avoid the recursion.
-  // Debug
-  dbprint(printlevel - voice, "// We do the reduction to the zerodimensional case, via decomp.");
-
-  primaryDec = newDecompStep(J, "oneIndep", "intersect", 2);
-  // Debug
-  dbprint(printlevel - voice, "// Proc decomp has found", size(primaryDec) / 2, "new primary components.");
-
-  return(primaryDec);
-}
-
-
-
-///////////////////////////////////////////////////////////////////////////////////
-// Based on maxIndependSet
-// Added list # as parameter
-// If the first element of # is 0, the output is only 1 max indep set.
-// If no list is specified or #[1] = 1, the output is all the max indep set of the
-// leading terms ideal. This is the original output of maxIndependSet
-
-proc newMaxIndependSetLp(ideal j, list #)
-"USAGE:   newMaxIndependentSetLp(i); i ideal (returns all maximal independent sets of the corresponding leading terms ideal)
-          newMaxIndependentSetLp(i, 0); i ideal (returns only one maximal independent set)
-RETURN:  list = #1. new varstring with the maximal independent set at the end,
-                #2. ordstring with the lp ordering,
-                #3. the number of independent variables
-NOTE:
-EXAMPLE: example newMaxIndependentSetLp; shows an example
-"
-{
-  int n, k, di;
-  list resu, hilf;
-  string var1, var2;
-  list v = indepSet(j, 0);
-
-  // SL 2006.04.21 1 Lines modified to use only one independent Set
-  string indepOption;
-  if (size(#) > 0)
-  {
-    indepOption = #[1];
-  }
-  else
-  {
-    indepOption = "allIndep";
-  }
-
-  int nMax;
-  if (indepOption == "allIndep")
-  {
-    nMax = size(v);
-  }
-  else
-  {
-    nMax = 1;
-  }
-
-  for(n = 1; n <= nMax; n++)
-  // SL 2006.04.21 2
-  {
-    di = 0;
-    var1 = "";
-    var2 = "";
-    for(k = 1; k <= size(v[n]); k++)
-    {
-      if(v[n][k] != 0)
-      {
-        di++;
-        var2 = var2 + "var(" + string(k) + "), ";
-      }
-      else
-      {
-        var1 = var1 + "var(" + string(k) + "), ";
-      }
-    }
-    if(di > 0)
-    {
-      var1 = var1 + var2;
-      var1 = var1[1..size(var1) - 2];       // The "- 2" removes the trailer comma
-      hilf[1] = var1;
-      // SL 2006.21.04 1 The order is now block dp instead of lp
-      //hilf[2] = "dp(" + string(nvars(basering) - di) + "), dp(" + string(di) + ")";
-      // SL 2006.21.04 2
-      // For decomp, lp ordering is needed. Nothing is changed.
-      hilf[2] = "lp";
-      hilf[3] = di;
-      resu[n] = hilf;
-    }
-    else
-    {
-      resu[n] = varstr(basering), ordstr(basering), 0;
-    }
-  }
-  return(resu);
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring s1 = (0, x, y), (a, b, c, d, e, f, g), lp;
-   ideal i = ea - fbg, fa + be, ec - fdg, fc + de;
-   i = std(i);
-   list l = newMaxIndependSetLp(i);
-   l;
-   i = i, g;
-   l = newMaxIndependSetLp(i);
-   l;
-
-   ring s = 0, (x, y, z), lp;
-   ideal i = z, yx;
-   list l = newMaxIndependSetLp(i);
-   l;
-}
-
-
-///////////////////////////////////////////////////////////////////////////////
-
-proc newZero_decomp (ideal j, ideal ser, int @wr, list #)
-"USAGE:   newZero_decomp(j,ser,@wr); j,ser ideals, @wr=0 or 1
-         (@wr=0 for primary decomposition, @wr=1 for computation of associated
-         primes)
-         if #[1] = "nest", then #[2] indicates the nest level (number of recursive calls)
-         When the nest level is high it indicates that the computation is difficult,
-         and different methods are applied.
-RETURN:  list = list of primary ideals and their radicals (at even positions
-         in the list) if the input is zero-dimensional and a standardbases
-         with respect to lex-ordering
-         If ser!=(0) and ser is contained in j or if j is not zero-dimen-
-         sional then ideal(1),ideal(1) is returned
-NOTE:    Algorithm of Gianni/Trager/Zacharias
-EXAMPLE: example newZero_decomp; shows an example
-"
-{
-  def   @P = basering;
-  int uytrewq;
-  int nva = nvars(basering);
-  int @k,@s,@n,@k1,zz;
-  list primary,lres0,lres1,act,@lh,@wh;
-  map phi,psi,phi1,psi1;
-  ideal jmap,jmap1,jmap2,helpprim,@qh,@qht,ser1;
-  intvec @vh,@hilb;
-  string @ri;
-  poly @f;
-
-  // Debug
-  dbprint(printlevel - voice, "proc newZero_decomp");
-
-  if (dim(j)>0)
-  {
-    primary[1]=ideal(1);
-    primary[2]=ideal(1);
-    return(primary);
-  }
-  j=interred(j);
-
-  attrib(j,"isSB",1);
-
-  int nestLevel = 0;
-  if (size(#) > 0)
-  {
-    if (typeof(#[1]) == "string")
-    {
-      if (#[1] == "nest")
-      {
-        nestLevel = #[2];
-      }
-      # = list();
-    }
-  }
-
-  if(vdim(j)==deg(j[1]))
-  {
-    act=factor(j[1]);
-    for(@k=1;@k<=size(act[1]);@k++)
-    {
-      @qh=j;
-      if(@wr==0)
-      {
-        @qh[1]=act[1][@k]^act[2][@k];
-      }
-      else
-      {
-        @qh[1]=act[1][@k];
-      }
-      primary[2*@k-1]=interred(@qh);
-      @qh=j;
-      @qh[1]=act[1][@k];
-      primary[2*@k]=interred(@qh);
-      attrib( primary[2*@k-1],"isSB",1);
-
-      if((size(ser)>0)&&(size(reduce(ser,primary[2*@k-1],1))==0))
-      {
-        primary[2*@k-1]=ideal(1);
-        primary[2*@k]=ideal(1);
-      }
-    }
-    return(primary);
-  }
-
-  if(homog(j)==1)
-  {
-    primary[1]=j;
-    if((size(ser)>0)&&(size(reduce(ser,j,1))==0))
-    {
-      primary[1]=ideal(1);
-      primary[2]=ideal(1);
-      return(primary);
-    }
-    if(dim(j)==-1)
-    {
-      primary[1]=ideal(1);
-      primary[2]=ideal(1);
-    }
-    else
-    {
-      primary[2]=maxideal(1);
-    }
-    return(primary);
-  }
-
-//the first element in the standardbase is factorized
-  if(deg(j[1])>0)
-  {
-    act=factor(j[1]);
-    testFactor(act,j[1]);
-  }
-  else
-  {
-    primary[1]=ideal(1);
-    primary[2]=ideal(1);
-    return(primary);
-  }
-
-//with the factors new ideals (hopefully the primary decomposition)
-//are created
-  if(size(act[1])>1)
-  {
-    if(size(#)>1)
-    {
-      primary[1]=ideal(1);
-      primary[2]=ideal(1);
-      primary[3]=ideal(1);
-      primary[4]=ideal(1);
-      return(primary);
-    }
-    for(@k=1;@k<=size(act[1]);@k++)
-    {
-      if(@wr==0)
-      {
-        primary[2*@k-1]=std(j,act[1][@k]^act[2][@k]);
-
-      }
-      else
-      {
-        primary[2*@k-1]=std(j,act[1][@k]);
-      }
-      if((act[2][@k]==1)&&(vdim(primary[2*@k-1])==deg(act[1][@k])))
-      {
-        primary[2*@k]   = primary[2*@k-1];
-      }
-      else
-      {
-        primary[2*@k]   = primaryTest(primary[2*@k-1],act[1][@k]);
-      }
-    }
-  }
-  else
-  {
-    primary[1]=j;
-    if((size(#)>0)&&(act[2][1]>1))
-    {
-      act[2]=1;
-      primary[1]=std(primary[1],act[1][1]);
-    }
-    if(@wr!=0)
-    {
-      primary[1]=std(j,act[1][1]);
-    }
-    if((act[2][1]==1)&&(vdim(primary[1])==deg(act[1][1])))
-    {
-      primary[2]=primary[1];
-    }
-    else
-    {
-      primary[2]=primaryTest(primary[1],act[1][1]);
-    }
-  }
-
-  if(size(#)==0)
-  {
-    primary=splitPrimary(primary,ser,@wr,act);
-  }
-
-  if((voice>=6)&&(char(basering)<=181))
-  {
-    primary=splitCharp(primary);
-  }
-
-  if((@wr==2)&&(npars(basering)>0)&&(voice>=6)&&(char(basering)>0))
-  {
-  //the prime decomposition of Yokoyama in characteristic p
-    list ke,ek;
-    @k=0;
-    while(@k<size(primary)/2)
-    {
-      @k++;
-      if(size(primary[2*@k])==0)
-      {
-        ek=insepDecomp(primary[2*@k-1]);
-        primary=delete(primary,2*@k);
-        primary=delete(primary,2*@k-1);
-        @k--;
-      }
-      ke=ke+ek;
-    }
-    for(@k=1;@k<=size(ke);@k++)
-    {
-      primary[size(primary)+1]=ke[@k];
-      primary[size(primary)+1]=ke[@k];
-    }
-  }
-
-  if(nestLevel > 1){primary=extF(primary);}
-
-//test whether all ideals in the decomposition are primary and
-//in general position
-//if not after a random coordinate transformation of the last
-//variable the corresponding ideal is decomposed again.
-  if((npars(basering)>0)&&(nestLevel > 1))
-  {
-    poly randp;
-    for(zz=1;zz<nvars(basering);zz++)
-    {
-      randp=randp
-              +(random(0,5)*par(1)^2+random(0,5)*par(1)+random(0,5))*var(zz);
-    }
-    randp=randp+var(nvars(basering));
-  }
-  @k=0;
-  while(@k<(size(primary)/2))
-  {
-    @k++;
-    if (size(primary[2*@k])==0)
-    {
-      for(zz=1;zz<size(primary[2*@k-1])-1;zz++)
-      {
-        attrib(primary[2*@k-1],"isSB",1);
-        if(vdim(primary[2*@k-1])==deg(primary[2*@k-1][zz]))
-        {
-          primary[2*@k]=primary[2*@k-1];
-        }
-      }
-    }
-  }
-
-  @k=0;
-  ideal keep;
-  while(@k<(size(primary)/2))
-  {
-    @k++;
-    if (size(primary[2*@k])==0)
-    {
-      jmap=randomLast(100);
-      jmap1=maxideal(1);
-      jmap2=maxideal(1);
-      @qht=primary[2*@k-1];
-      if((npars(basering)>0)&&(nestLevel > 1))
-      {
-        jmap[size(jmap)]=randp;
-      }
-
-      for(@n=2;@n<=size(primary[2*@k-1]);@n++)
-      {
-        if(deg(lead(primary[2*@k-1][@n]))==1)
-        {
-          for(zz=1;zz<=nva;zz++)
-          {
-            if(lead(primary[2*@k-1][@n])/var(zz)!=0)
-            {
-              jmap1[zz]=-1/leadcoef(primary[2*@k-1][@n])*primary[2*@k-1][@n]
-                  +2/leadcoef(primary[2*@k-1][@n])*lead(primary[2*@k-1][@n]);
-              jmap2[zz]=primary[2*@k-1][@n];
-              @qht[@n]=var(zz);
-            }
-          }
-          jmap[nva]=subst(jmap[nva],lead(primary[2*@k-1][@n]),0);
-        }
-      }
-      if(size(subst(jmap[nva],var(1),0)-var(nva))!=0)
-      {
-        // jmap[nva]=subst(jmap[nva],var(1),0);
-        //hier geaendert +untersuchen!!!!!!!!!!!!!!
-      }
-      phi1=@P,jmap1;
-      phi=@P,jmap;
-      for(@n=1;@n<=nva;@n++)
-      {
-        jmap[@n]=-(jmap[@n]-2*var(@n));
-      }
-      psi=@P,jmap;
-      psi1=@P,jmap2;
-      @qh=phi(@qht);
-
-//=================== the new part ============================
-
-      @qh=groebner(@qh,"par2var");
-
-//=============================================================
-//       if(npars(@P)>0)
-//       {
-//          @ri= "ring @Phelp ="
-//                  +string(char(@P))+",
-//                   ("+varstr(@P)+","+parstr(@P)+",@t),(C,dp);";
-//       }
-//       else
-//       {
-//          @ri= "ring @Phelp ="
-//                  +string(char(@P))+",("+varstr(@P)+",@t),(C,dp);";
-//       }
-//       execute(@ri);
-//       ideal @qh=homog(imap(@P,@qht),@t);
-//
-//       ideal @qh1=std(@qh);
-//       @hilb=hilb(@qh1,1);
-//       @ri= "ring @Phelp1 ="
-//                  +string(char(@P))+",("+varstr(@Phelp)+"),(C,lp);";
-//       execute(@ri);
-//       ideal @qh=homog(imap(@P,@qh),@t);
-//       kill @Phelp;
-//       @qh=std(@qh,@hilb);
-//       @qh=subst(@qh,@t,1);
-//       setring @P;
-//       @qh=imap(@Phelp1,@qh);
-//       kill @Phelp1;
-//       @qh=clearSB(@qh);
-//       attrib(@qh,"isSB",1);
-//=============================================================
-
-      ser1=phi1(ser);
-      @lh=newZero_decomp (@qh,phi(ser1),@wr, list("nest", nestLevel + 1));
-
-      kill lres0;
-      list lres0;
-      if(size(@lh)==2)
-      {
-        helpprim=@lh[2];
-        lres0[1]=primary[2*@k-1];
-        ser1=psi(helpprim);
-        lres0[2]=psi1(ser1);
-        if(size(reduce(lres0[2],lres0[1],1))==0)
-        {
-          primary[2*@k]=primary[2*@k-1];
-          continue;
-        }
-      }
-      else
-      {
-        lres1=psi(@lh);
-        lres0=psi1(lres1);
-      }
-
-//=================== the new part ============================
-
-      primary=delete(primary,2*@k-1);
-      primary=delete(primary,2*@k-1);
-      @k--;
-      if(size(lres0)==2)
-      {
-        lres0[2]=groebner(lres0[2],"par2var");
-      }
-      else
-      {
-        for(@n=1;@n<=size(lres0)/2;@n++)
-        {
-          if(specialIdealsEqual(lres0[2*@n-1],lres0[2*@n])==1)
-          {
-            lres0[2*@n-1]=groebner(lres0[2*@n-1],"par2var");
-            lres0[2*@n]=lres0[2*@n-1];
-            attrib(lres0[2*@n],"isSB",1);
-          }
-          else
-          {
-            lres0[2*@n-1]=groebner(lres0[2*@n-1],"par2var");
-            lres0[2*@n]=groebner(lres0[2*@n],"par2var");
-          }
-        }
-      }
-      primary=primary+lres0;
-
-//=============================================================
-//       if(npars(@P)>0)
-//       {
-//          @ri= "ring @Phelp ="
-//                  +string(char(@P))+",
-//                   ("+varstr(@P)+","+parstr(@P)+",@t),(C,dp);";
-//       }
-//       else
-//       {
-//          @ri= "ring @Phelp ="
-//                  +string(char(@P))+",("+varstr(@P)+",@t),(C,dp);";
-//       }
-//       execute(@ri);
-//       list @lvec;
-//       list @lr=imap(@P,lres0);
-//       ideal @lr1;
-//
-//       if(size(@lr)==2)
-//       {
-//          @lr[2]=homog(@lr[2],@t);
-//          @lr1=std(@lr[2]);
-//          @lvec[2]=hilb(@lr1,1);
-//       }
-//       else
-//       {
-//          for(@n=1;@n<=size(@lr)/2;@n++)
-//          {
-//             if(specialIdealsEqual(@lr[2*@n-1],@lr[2*@n])==1)
-//             {
-//                @lr[2*@n-1]=homog(@lr[2*@n-1],@t);
-//                @lr1=std(@lr[2*@n-1]);
-//                @lvec[2*@n-1]=hilb(@lr1,1);
-//                @lvec[2*@n]=@lvec[2*@n-1];
-//             }
-//             else
-//             {
-//                @lr[2*@n-1]=homog(@lr[2*@n-1],@t);
-//                @lr1=std(@lr[2*@n-1]);
-//                @lvec[2*@n-1]=hilb(@lr1,1);
-//                @lr[2*@n]=homog(@lr[2*@n],@t);
-//                @lr1=std(@lr[2*@n]);
-//                @lvec[2*@n]=hilb(@lr1,1);
-//
-//             }
-//         }
-//       }
-//       @ri= "ring @Phelp1 ="
-//                  +string(char(@P))+",("+varstr(@Phelp)+"),(C,lp);";
-//       execute(@ri);
-//       list @lr=imap(@Phelp,@lr);
-//
-//       kill @Phelp;
-//       if(size(@lr)==2)
-//      {
-//          @lr[2]=std(@lr[2],@lvec[2]);
-//          @lr[2]=subst(@lr[2],@t,1);
-//
-//       }
-//       else
-//       {
-//          for(@n=1;@n<=size(@lr)/2;@n++)
-//          {
-//             if(specialIdealsEqual(@lr[2*@n-1],@lr[2*@n])==1)
-//             {
-//                @lr[2*@n-1]=std(@lr[2*@n-1],@lvec[2*@n-1]);
-//                @lr[2*@n-1]=subst(@lr[2*@n-1],@t,1);
-//                @lr[2*@n]=@lr[2*@n-1];
-//                attrib(@lr[2*@n],"isSB",1);
-//             }
-//             else
-//             {
-//                @lr[2*@n-1]=std(@lr[2*@n-1],@lvec[2*@n-1]);
-//                @lr[2*@n-1]=subst(@lr[2*@n-1],@t,1);
-//                @lr[2*@n]=std(@lr[2*@n],@lvec[2*@n]);
-//                @lr[2*@n]=subst(@lr[2*@n],@t,1);
-//             }
-//          }
-//       }
-//       kill @lvec;
-//       setring @P;
-//       lres0=imap(@Phelp1,@lr);
-//       kill @Phelp1;
-//       for(@n=1;@n<=size(lres0);@n++)
-//       {
-//          lres0[@n]=clearSB(lres0[@n]);
-//          attrib(lres0[@n],"isSB",1);
-//       }
-//
-//       primary[2*@k-1]=lres0[1];
-//       primary[2*@k]=lres0[2];
-//       @s=size(primary)/2;
-//       for(@n=1;@n<=size(lres0)/2-1;@n++)
-//       {
-//         primary[2*@s+2*@n-1]=lres0[2*@n+1];
-//         primary[2*@s+2*@n]=lres0[2*@n+2];
-//       }
-//       @k--;
-//=============================================================
-    }
-  }
-  return(primary);
-}
-example
-{ "EXAMPLE:"; echo = 2;
-   ring  r = 0,(x,y,z),lp;
-   poly  p = z2+1;
-   poly  q = z4+2;
-   ideal i = p^2*q^3,(y-z3)^3,(x-yz+z4)^4;
-   i=std(i);
    list  pr= newZero_decomp(i,ideal(0),0);
    pr;
