Index: Singular/LIB/resgraph.lib
===================================================================
--- Singular/LIB/resgraph.lib	(revision 2e6eac218988a6cdb89b0be44b0a24dd62ac41a7)
+++ Singular/LIB/resgraph.lib	(revision 2e6eac218988a6cdb89b0be44b0a24dd62ac41a7)
@@ -0,0 +1,721 @@
+proc InterDiv(intmat M, list #)
+{
+  "Warning: alpha testing version of this procedure";
+  int i,j;
+  string tempstr;
+//---------------------------------------------------------------------------
+//  build up temporary filename and open file for writing
+//---------------------------------------------------------------------------
+  if(size(#)>0)
+  {
+     if((typeof(#[1])=="string") && (goodFilename(#[1])))
+     {
+        string @filename=#[1];
+     }
+     else
+     {
+        ERROR("Second argument should specify a WRITABLE file");
+     }
+  }
+  if(!defined(@filename))
+  {
+     string @filename=buildFilename("InterDiv.dot");
+  }
+  link eing=":w "+@filename;
+//--------------------------------------------------------------------------
+// write input for external program dot to file
+//--------------------------------------------------------------------------
+  write(eing,"graph G{");
+  for(i=1;i<=ncols(M);i++)
+  {
+     if(M[i,i]!=-2)
+     {
+        tempstr=string(i)+"[shape=circle,label=\""+string(M[i,i])+"\"];";
+     }
+     else
+     {
+        tempstr=string(i)+"[shape=point,label=\" \"];";
+     }
+     write(eing,tempstr);
+  }
+  for(i=1;i<=nrows(M);i++)
+  {
+     for(j=i+1;j<=ncols(M);j++)
+     {
+        if(M[i,j]!=0)
+        {
+           tempstr=string(i) + "--" + string(j) + ";";
+           write(eing,tempstr);
+        }
+     }
+  }
+  write(eing,"}");
+  close(eing);
+//---------------------------------------------------------------------------
+// produce graphics output using the programs dot and xv
+//---------------------------------------------------------------------------
+  string outfile=@filename + ".jpg";
+  if(!find(outfile,"/"))
+  {
+//--- xv needs fully qualified path to file
+     outfile=system("getenv","PWD") + "/" + outfile;
+  }
+  j=system("sh","dot -Tjpg " + @filename + " -o "+ outfile);
+  j=system("sh","/usr/bin/X11/xv " + outfile + " &");
+//---------------------------------------------------------------------------
+// clean up if necessary
+//---------------------------------------------------------------------------
+  "Currently showing graphics in separate window";
+  "Press <Return> to continue";
+  pause();
+  if((size(#)==0)&&(find(@filename,"/tmp/")))
+  {
+//--- do not leave any garbage in the public directories
+    j=system("sh","/bin/rm " + outfile + " " + @filename);
+  }
+  return();
+}
+///////////////////////////////////////////////////////////////////////////////
+//static
+proc goodFilename(string datei)
+{
+//--- check whether the specified file datei is writable for us
+  if(!system("sh","touch " + datei + " > /dev/null 2>&1"))
+  {
+     return(1);
+  }
+  else
+  {
+     return(0);
+  }
+}
+//////////////////////////////////////////////////////////////////////////////
+//static
+proc buildFilename(string datei)
+{
+  if(goodFilename(datei))
+  {
+     return(datei);
+  }
+  if(find(datei,"/"))
+  {
+     ERROR("Specified directory/file is not writable");
+  }
+  datei="/tmp/" + datei;
+  if(goodFilename(datei))
+  {
+     return(datei);
+  }
+//--- not reached
+  ERROR("At least /tmp should be writable");
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc ResTree(list re, intmat DivMat, list #)
+{
+//-----------------------------------------------------------------------------
+// Initialization and definition of the temporary filename
+//-----------------------------------------------------------------------------
+  int i,j,dimC,jsave;
+  string tempstr;
+  def R=basering;
+  if(size(#)>0)
+  {
+     if(typeof(#[1])=="string")
+     {
+        if(goodFilename(#[1]))
+        {
+           string @filename=#[1];
+        }
+        else
+        {
+           ERROR("optional argument of type string "+
+                  "should specify a writable file.");
+        }
+     }
+     if(typeof(#[1])=="intvec")
+     {
+        intvec @rot=#[1];
+     }
+  }
+  if(size(#)>1)
+  {
+     if((typeof(#[2])=="string")&&(!defined(@filename)))
+     {
+        if(goodFilename(#[1]))
+        {
+           string @filename=#[1];
+        }
+        else
+        {
+           ERROR("optional argument of type string "+
+                  "should specify a writable file.");
+        }
+     }
+     if((typeof(#[2])=="intvec")&&(!defined(@rot)))
+     {
+        intvec @rot=#[2];
+     }
+  }
+  if(!defined(@filename))
+  {
+     string @filename=buildFilename("ResTree.dot");
+  }
+  if(!defined(@rot))
+  {
+     intvec @rot;
+     @rot[size(re[2])]=0;
+  }
+  link eing=":w "+@filename;
+//----------------------------------------------------------------------------
+// writing the input to the program dot into a file
+//----------------------------------------------------------------------------
+  write(eing,"graph G{");
+  tempstr="1[shape=box,label=\"chart 1\"];";
+  write(eing,tempstr);
+  for(i=2;i<=size(re[2]);i++)
+  {
+     tempstr=string(i)+"[shape=box,label=\"chart " + string(i)
+            + "\\nE:"+string(simplify(ideal(DivMat[i,1..ncols(DivMat)]),2))
+            + " \"";
+     if(@rot[i]==1)
+     {
+        tempstr=tempstr + "color=\"red\"];";
+     }
+     else
+     {
+        tempstr=tempstr + "];";
+     }
+     write(eing,tempstr);
+  }
+  for(i=2;i<=size(re[2]);i++)
+  {
+     def S=re[2][i];
+     setring S;
+     j=int(leadcoef(path[1,ncols(path)]));
+     if(j!=jsave)
+     {
+        def T=re[2][j];
+        setring T;
+        dimC=dim(std(BO[1]+cent));
+        setring S;
+        kill T;
+     }
+     setring R;
+     kill S;
+     if(j!=jsave)
+     {
+        tempstr=string(j) + "--" + string(i) +"[label=\"d=" + string(dimC)
+               + "\"];";
+        jsave=j;
+     }
+     else
+     {
+       tempstr=string(j) + "--" + string(i) +";";
+     }
+     write(eing,tempstr);
+  }
+  write(eing,"}");
+  close(eing);
+//---------------------------------------------------------------------------
+// Create the graphics output using the programs dot and xv
+//---------------------------------------------------------------------------
+  string outfile=@filename + ".jpg";
+  if(!find(outfile,"/"))
+  {
+//--- xv needs fully qualified path to file
+     outfile=system("getenv","PWD") + "/" + outfile;
+  }
+  j=system("sh", "dot -Tjpg " + @filename + " -o "+ outfile);
+  j=system("sh","/usr/bin/X11/xv " + outfile + "&");
+//---------------------------------------------------------------------------
+// Clean up public directories if necessary
+//---------------------------------------------------------------------------
+  "Currently showing graphics in separate window";
+  "Press <Return> to continue";
+  pause();
+  if(find(@filename,"/tmp/"))
+  {
+//--- do not leave any garbage in the public directories
+    j=system("sh","/bin/rm " + @filename + ".jpg "+ @filename);
+  }
+  return();
+}
+/////////////////////////////////////////////////////////////////////////////
+
+proc finalCharts(list re, list inter, intvec endiv, list #)
+{
+//-----------------------------------------------------------------------------
+// Initialization and Sanity Checks
+//-----------------------------------------------------------------------------
+  int i,j,k,a,b,cnt,whichE,offset,haveDcE8;
+  def R=basering;
+  list endCharts;
+  string fname,tempstr;
+  for(i=1;i<=size(endiv);i++)
+  {
+    if(endiv[i]==1)
+    {
+       endCharts[size(endCharts)+1]=i;
+//--- Sanity checks for the chart i
+       if(nvars(re[2][i])!=3)
+       {
+          ERROR("This chart is not embedded in 3-dimensional space");
+       }
+       if(defined(S)){kill S;}
+       def S=re[2][i];
+       setring S;
+       if(dim(std(BO[1]+BO[2]))!=2)
+       {
+          ERROR("Strict Transform is not a surface");
+       }
+       if(size(equidim(BO[1]+BO[2]))!=1)
+       {
+          ERROR("Strict Transform has lower dimensional components.");
+       }
+//--- put the missing information into dcE, if necessary
+       for(k=1;k<=size(dcE);k++)
+       {
+          for(j=1;j<=size(dcE[k]);j++)
+          {
+             if(deg(std(dcE[k][j][1])[1])!=0)
+             {
+                if(size(dcE[k][j][1]) < 8)
+                {
+                   setring R;
+                   k=prepareDcE(re,inter,endiv);
+                   setring S;
+                }
+                haveDcE8=1;
+                break;
+             }
+          }
+          if(haveDcE8!=0) break;
+       }
+       setring R;
+    }
+  }
+  if(!defined(colorlist))
+  {
+     list colorlist;
+     for(i=1;i<=10;i++)
+     {
+       colorlist[i]="curve_red = "+string((i-1)*25)+"; curve_green = "+
+                     string(255-(i-1)*25)+"; curve_blue = "+
+                     string(((i-1) mod 5)*50)+";";
+     }
+  }
+  else
+  {
+     "Warning!";
+     "Using colors specified in variable colorlist. No syntax checks";
+     "performed on the content of this list.";
+     "If built-in colors should be used, please rename the global";
+     "object colorlist";
+  }
+  if(ncols(inter[1])>size(colorlist))
+  {
+    ERROR("Too many exceptional curves on this surface.....");
+  }
+  if((size(endCharts)>20)&&(size(#)==0))
+  {
+    ERROR("More than 20 final charts...");
+  }
+//-----------------------------------------------------------------------------
+// Determine the basename of the temporary files
+//-----------------------------------------------------------------------------
+  if(size(#)>0)
+  {
+     if((typeof(#[1])=="string") && (goodFilename(#[1])))
+     {
+        string fnamebase=#[1];
+     }
+     else
+     {
+        ERROR("Second argument should specify a WRITABLE file");
+     }
+  }
+  if(!defined(@fnamebase))
+  {
+     string fnamebase=buildFilename("Chart");
+  }
+//-----------------------------------------------------------------------------
+// Go through all final charts and write a separate surf input file for each
+//-----------------------------------------------------------------------------
+  for(i=1;i<=size(endCharts);i++)
+  {
+     fname=fnamebase + string(endCharts[i]) + ".surf";
+     if(defined(eing)){kill eing;}
+     link eing=":w "+fname;
+//--- define surf's root finding algorithm
+     tempstr="root_finder = d_chain_bisection; epsilon = 0.000000001;";
+     write(eing,tempstr);
+//--- define image size
+     tempstr="int wid = 480;width = wid; height = wid;";
+     write(eing,tempstr);
+//--- define ambient lighting
+     tempstr="ambient=50;";
+     write(eing,tempstr);
+//--- define background colour: some shade of gray
+     tempstr="background_red=200; background_green=200; background_blue=200;";
+     write(eing,tempstr);
+//--- define surface colour (one side):
+     tempstr="surface_red=22; surface_green=150; surface_blue=255;";
+     write(eing,tempstr);
+//--- define surface colour (other side):
+     tempstr="inside_red=255; inside_green=192; inside_blue=0;";
+     write(eing,tempstr);
+//--- define scaling factor
+     tempstr="scale_x=0.5; scale_y=0.5; scale_z=0.5;";
+     write(eing,tempstr);
+//--- rotate a little bit
+     tempstr="rot_y=0.9013941717697173; rot_x=-0.5556596516994916; rot_z=0.103062920202253447;";
+     write(eing,tempstr);
+//----------------------------------------------------------------------------
+// change to the chart and extract the equation of the surface
+// then draw the surface
+//----------------------------------------------------------------------------
+     if(defined(S)){kill S;}
+     def S=re[2][endCharts[i]];
+     setring S;
+//--- define equation of strict transform (hypersurface of dim 2)
+     ideal drawJ=simplify(mstd(radical(BO[1]+BO[2]))[2],2);
+     if(size(drawJ)>1)
+     {
+//!!! unnoetig! Da kann man auch surface2,... machen
+        ERROR("Did not find generator of principal ideal " + string(drawJ));
+     }
+     tempstr="poly f = " + map2Surf(string(drawJ[1])) + ";";
+     write(eing,tempstr);
+     tempstr="surface = f;draw_surface;";
+     write(eing,tempstr);
+//----------------------------------------------------------------------------
+// now consider all exceptional curves in this chart separately
+// and draw them
+//---------------------------------------------------------------------------
+     if(!defined(dcE))
+     {
+//--- Oups, exceptional curves not yet decomposed in this chart
+//--- should not happen in practice
+        ERROR("The procedure intersectionDiv has not been used
+               on this tree of charts");
+     }
+     for(j=1;j<=size(dcE);j++)
+     {
+//--- Run through all exceptional divisors (in the embedded sense)
+        for(k=1;k<=size(dcE[j]);k++)
+        {
+//--- Run through all curves corresponding to the current divisor
+           if(deg(std(dcE[j][k][1])[1])==0)
+           {
+//--- This one is empty - skip it
+              k++;
+              if(k>size(dcE[j])) {break;}
+              continue;
+           }
+           for(a=1;a<=size(inter[3]);a++)
+           {
+//--- this curve belongs to which (Q-irred.) divisor in global numbering?
+              if(inIVList(intvec(endCharts[i],j,k),inter[3][a])) break;
+           }
+           if(a>size(inter[3]))
+           {
+//--- curve not found in list
+              ERROR("Inconsistency between data of arguments 1 and 2");
+           }
+           whichE=a;
+           offset=0;
+           for(a=1;a<whichE;a++)
+           {
+//--- count C-irred. divisors up to this (Q-irred. divisor) index
+              offset=offset+inter[4][a];
+           }
+           for(a=1;a<=size(dcE[j][k][7]);a++)
+           {
+//--- run through all C-irred divisors corresponding to this Q-irred. one
+//--- run through all generators of the ideal of the curve
+//--- unfortunately the ideal is encoded in a string,
+//--- and we need to work to find the generators
+              int tempint=find(dcE[j][k][6],",");
+              b=0;
+              cnt=1;
+              while(tempint!=0)
+              {
+                if(!find(dcE[j][k][7][a],"i"))
+                {
+//--- 1) surf can only handle real numbers ==> we ignore the other curves
+//--- 2) we can only form substrings of named strings:
+                  tempstr=dcE[j][k][6];            // give it a name
+                  tempstr=tempstr[b+1..tempint-1]; // find correct substring
+                  tempstr="poly f" + string(offset+dcE[j][k][8][a])+ "_" +
+                       string(b+1) + " = " +
+                       map2Surf(plugInNumZero(tempstr,dcE[j][k][7][a])) + ";";
+                  write(eing,tempstr);
+                  tempstr="cutsurface" + string(cnt) + " = f" +
+                       string(offset+dcE[j][k][8][a]) + "_" +string(b+1) + ";";
+                  write(eing,tempstr);
+                  cnt++;
+                }
+                b=tempint;                          // save end-mark
+                tempint=find(dcE[j][k][6],",",b+1); // next one please
+              }
+              if(!find(dcE[j][k][7][a],"i"))
+              {
+                tempstr=dcE[j][k][6];                 // as before, but for last
+                tempstr=tempstr[b+1..size(tempstr)];  // fragment
+                tempstr="poly f" + string(offset+dcE[j][k][8][a])+ "_" +
+                       string(b+1) + " = " +
+                       map2Surf(plugInNumZero(tempstr,dcE[j][k][7][a])) + ";";
+                write(eing,tempstr);
+                tempstr="cutsurface" + string(cnt)+ " = f" +
+                       string(offset+dcE[j][k][8][a]) + "_" +string(b+1) + ";";
+                write(eing,tempstr);
+                cnt++;
+              }
+//--- draw the curve on the surface
+              if(cnt>1)
+              {
+                 tempstr=colorlist[offset+dcE[j][k][8][a]];
+                 write(eing,tempstr);
+                 write(eing,"cut_with_surface;");
+              }
+              kill tempint;
+           }
+        }
+     }
+     if(!find(fnamebase,"/"))
+     {
+//--- xv needs fully qualified path to file
+         if(defined(outfile)) {kill outfile;}
+         string outfile=system("getenv","PWD") + "/" + fnamebase;
+     }
+     if(!defined(outfile))
+     {
+       tempstr="filename = \"" + fnamebase + string(endCharts[i]) + ".ras\";";
+     }
+     else
+     {
+       tempstr="filename = \"" + outfile + string(endCharts[i]) + ".ras\";";
+     }
+     write(eing,tempstr);
+     tempstr="color_file_format = sun;";
+     write(eing,tempstr);
+     tempstr="save_color_image;";
+     write(eing,tempstr);
+     close(eing);
+     j=system("sh", "surf -n " + fnamebase +string(endCharts[i]) + ".surf");
+     if(!defined(outfile))
+     {
+        j=system("sh","/usr/bin/X11/xv " + fnamebase
+                       + string(endCharts[i]) + ".ras &");
+     }
+     else
+     {
+        j=system("sh","/usr/bin/X11/xv " + outfile
+                       + string(endCharts[i]) + ".ras &");
+        kill outfile;
+     }
+     "Currently showing graphics for chart "+string(endCharts[i])
+                    +" in separate window";
+     "Press <Return> to continue";
+     pause();
+  }
+  return(0);
+}
+//////////////////////////////////////////////////////////////////////////////
+// static
+proc plugInNumZero(string f,string num)
+{
+  int i;
+  string fStr=f;
+  i=find(fStr,"t");
+  while(i!=0)
+  {
+    fStr = string(fStr[1..i-1]) + "(" + num + ")"
+         + string(fStr[i+1..size(fStr)]);
+    i=find(fStr,"t");
+  }
+  return(fStr);
+}
+//////////////////////////////////////////////////////////////////////////////
+// static
+proc replaceInStr(string alles, string alt, string neu)
+{
+  int i=find(alles,alt);
+  while(i!=0)
+  {
+    if((i-1)<1)
+    {
+       if(size(alt)==size(alles))
+       {
+          alles=neu;
+       }
+       else
+       {
+          alles=neu + string(alles[i+size(alt)..size(alles)]);
+       }
+    }
+    else
+    {
+       if(i+size(alt)>size(alles))
+       {
+          alles=string(alles[1..i-1]) + neu;
+       }
+       else
+       {
+          alles=string(alles[1..i-1]) + neu +
+                string(alles[i+size(alt)..size(alles)]);
+       }
+    }
+    i=find(alles,alt);
+  }
+  return(alles);
+}
+/////////////////////////////////////////////////////////////////////////////
+// static
+proc map2Surf(string str)
+{
+  str=replaceInStr(str,string(var(1)),"x");
+  str=replaceInStr(str,string(var(2)),"y");
+  str=replaceInStr(str,string(var(3)),"z");
+  return(str);
+}
+/////////////////////////////////////////////////////////////////////////////
+// static
+proc prepareDcE(list re, list inter, list endCharts)
+{
+   def R=basering;
+//---Test whether we are in the irreducible surface case
+   def S=re[2][1];
+   setring S;
+   BO[2]=BO[2]+BO[1];              // make sure we are living in the smooth W
+   if(dim(std(BO[2]))!=2)
+   {
+     ERROR("The given original object is not a surface");
+   }
+   if(dim(std(slocus(BO[2])))>0)
+   {
+     ERROR("The given original object has non-isolated singularities.");
+   }
+   setring R;
+//----------------------------------------------------------------------------
+// Compute a non-embedded resolution from the given embedded one by
+// dropping redundant trailing blow-ups
+//----------------------------------------------------------------------------
+//--- compute non-embedded resolution
+   int ii,j,k,a,b,comPa;
+   list abst=abstractR(re);
+   intvec endiv=abst[1];
+   intvec deleted=abst[2];
+//--- identify the divisors in the various final charts
+   list iden0=collectDiv(re,deleted)[2];
+                                    // list of final divisors
+//----------------------------------------------------------------------------
+// For each Q-irred. divisor (specified in inter[3]), run through all
+// occurrences and identify the different C-components
+//----------------------------------------------------------------------------
+   for(ii=1;ii<=size(inter[3]);ii++)
+   {
+//--- run through all Q-irred. curves,
+//--- set up the first occurrence for reference
+      if(defined(S)) {kill S;}
+      def S=re[2][inter[3][ii][1][1]];
+                                    // inter[3] = list of Q-irred div.
+                                    // inter[3][ii] = ii-th thereof
+                                    // inter[3][ii][1] = first occurrence
+                                    // inter[3][ii][1][1] = corr. chart index
+      setring S;
+      dcE[inter[3][ii][1][2]][inter[3][ii][1][3]][8]=
+              intvec(1..ncols(dcE[inter[3][ii][1][2]][inter[3][ii][1][3]][4]));
+//--- prepare the ideal of the divisor for mapping to different chart
+      if(defined(idlist1)){kill idlist1;}
+      list idlist1;
+      idlist1[1]=dcE[inter[3][ii][1][2]][inter[3][ii][1][3]][6];
+      export(idlist1);
+      for(j=2;j<=size(inter[3][ii]);j++)
+      {
+//--- now do the comparison with the other occurrences
+//--- 1. find a common parent for inter[3][ii][1][1] and inter[3][ii][j][1]
+         if(defined(S)){kill S;}
+         def S=re[2][inter[3][ii][j][1]];
+         setring S;
+         if(defined(opath)){kill opath;}
+         def opath=imap(re[2][inter[3][ii][1][1]],path);
+         k=1;
+         while(opath[1,k]==path[1,k])
+         {
+            k++;
+            if((k>ncols(opath))||(k>ncols(path))) break;
+         }
+         comPa=int(leadcoef(opath[1,k-1]));
+//--- 2. use fetchInTree to transfer the C-components
+         if(defined(str)) {kill str;}
+         if(defined(il)) {kill il;}
+         if(defined(mpi)) {kill mpi;}
+         if(defined(nulli)) {kill nulli;}
+         string str="idlist1";
+         attrib(str,"algext",imap(re[2][inter[3][ii][1][1]],dcE)[inter[3][ii][1][2]][inter[3][ii][1][3]][5]);
+         list il=fetchInTree(re,inter[3][ii][1][1],comPa,inter[3][ii][j][1],str,iden0,1);
+         list nulli=imap(re[2][inter[3][ii][1][1]],dcE)[inter[3][ii][1][2]][inter[3][ii][1][3]][7];
+         string mpi=imap(re[2][inter[3][ii][1][1]],dcE)[inter[3][ii][1][2]][inter[3][ii][1][3]][5];
+         if(mpi!=dcE[inter[3][ii][j][2]][inter[3][ii][j][3]][5])
+         {
+            ERROR("Problem identifying the appropriate field extension.!");
+         }
+         if(defined(ringt)){kill ringt;}
+         ring ringt=0,(t),dp;
+         if(defined(St)){kill St;}
+         def St=S+ringt;
+         setring St;
+         if(defined(strId)) {kill strId;}
+         string strId="ideal id1=" + il[1] + ";";
+         execute(strId);
+         id1=std(id1);
+         strId="ideal idj="
+                         + imap(S,dcE)[inter[3][ii][j][2]][inter[3][ii][j][3]][6]
+                         +  ";";
+         execute(strId);
+         idj=std(idj);
+         if(defined(nullj)){kill nullj;}
+         list nullj=imap(S,dcE)[inter[3][ii][1][2]][inter[3][ii][1][3]][7];
+         if(defined(rcomp)){kill rcomp;}
+         strId="ring rcomp=complex,(" +varstr(basering) +"),(" +
+                           ordstr(basering) + ");";
+         execute(strId);
+         def id1=imap(St,id1);
+         def idj=imap(St,idj);
+         ideal id10,idj0;
+         if(defined(tintvec)){kill tintvec;}
+         intvec tintvec;
+         tintvec[size(nullj)]=0;
+         for(a=1;a<=size(nullj);a++)
+         {
+            if(defined(numa)) {kill numa;}
+            strId="number numa=" + string(nullj[a]) + ";";
+            execute(strId);
+            idj0=subst(idj,t,numa);
+            for(b=1;b<=size(nulli);b++)
+            {
+               if(defined(numb)) {kill numb;}
+               strId="number numb=" + string(nulli[b]) + ";";
+               execute(strId);
+               id10=subst(id1,t,numb);
+               attrib(id10,"isSB",1);
+               if(size(reduce(idj0,id10))==0)
+               {
+                  tintvec[a]=b;
+                  break;
+               }
+            }
+            if(!find(string(tintvec),string(b)))
+            {
+~;
+               ERROR("Problem identifying C-components in different charts.");
+            }
+         }
+         setring S;
+         dcE[inter[3][ii][1][2]][inter[3][ii][1][3]][8]=tintvec;
+      }
+   }
+   return(0);
+}
Index: Singular/LIB/resolve.lib
===================================================================
--- Singular/LIB/resolve.lib	(revision 2e6eac218988a6cdb89b0be44b0a24dd62ac41a7)
+++ Singular/LIB/resolve.lib	(revision 2e6eac218988a6cdb89b0be44b0a24dd62ac41a7)
@@ -0,0 +1,4805 @@
+///////////////////////////////////////////////////////////////////////////////
+version="$Id: resolve.lib,v 1.2 2005-05-03 14:22:07 Singular Exp $";
+category="Commutative Algebra";
+info="
+LIBRARY:  resol.lib      Resolution of singularities (Desingularization)
+                         Algorithm of Villamayor
+AUTHORS:  A. Fruehbis-Krueger,  anne@mathematik.uni-kl.de,
+@*        G. Pfister,           pfister@mathematik.uni-kl.de
+
+MAIN PROCEDURES:
+ blowUp(J,C[,W,E]) computes the blowing up of the variety V(J) inside V(W) in
+                   the center V(C)
+ Center(J[,W,E])   computes 'Villamayor'-center for blow up
+ resolve(J)        computes the desingularization of the variety V(J)
+
+AUXILLARY PROCEDURES:
+ blowUpBO(BO,C)  computes the blowing up of the variety V(BO[1]) in the
+                 center V(C). BO is a list (basic object), C is an ideal
+ createBO(J,W,E) creates basic object from input data
+ CenterBO(BO)    computes the center for the next blow-up of the
+                 given basic object
+ Delta(BO)       apply the Delta-operator of [Bravo,Encinas,Villamayor]
+ DeltaList(BO)   list of results of Delta^0 to Delta^bmax
+ showBO(BO)      prints the content of a BO in more human readable form
+";
+LIB "elim.lib";
+LIB "primdec.lib";
+LIB "presolve.lib";
+LIB "linalg.lib";
+LIB "sing.lib";
+///////////////////////////////////////////////////////////////////////////////
+//                      Tasks:
+//                     1) optimization of the local case
+//                     2) optimization in Coeff
+//                     3) change invariant to represent coeff=1 case
+//                     4) create procedures marked by * in above list
+///////////////////////////////////////////////////////////////////////////////
+
+proc createBO(ideal J,list #)
+"USAGE:  createBO(J[,W][,E]);
+@*       J,W = ideals
+@*       E     = list
+ASSUME:  J  = ideal containing W ( W = 0 if not specified)
+@*       E  = list of smooth hypersurfaces (e.g. exceptional divisors)
+RETURN:  list BO representing a basic object :
+         BO[1] ideal W, if W has been specified; ideal(0) otherwise
+         BO[2] ideal J
+         BO[3] intvec
+         BO[4] the list E of exceptional divisors if specified;
+               empty list otherwise
+         BO[5] an ideal defining the identity map
+         BO[6] an intvec
+         BO[7] intvec
+         BO[8] a matrix
+         entries 3,5,6,7,8 are initialized appropriately for use of CenterBO
+         and blowUpBO
+EXAMPLE: example createBO;  shows an example
+"
+{
+  ideal W;
+  list E;
+  ideal abb=maxideal(1);
+  intvec v;
+  intvec bvec;
+  intvec w=-1;
+  matrix intE;
+  if(size(#)>0)
+  {
+    if(typeof(#[1])=="ideal")
+    {
+      W=#[1];
+    }
+    if(typeof(#[1])=="list")
+    {
+      E=#[1];
+    }
+    if(size(#)>1)
+    {
+      if((typeof(#[2])=="list") && (size(E)==0))
+      {
+        E=#[2];
+      }
+      if((typeof(#[2])=="ideal") && (size(W)==0))
+      {
+        W=#[2];
+      }
+    }
+  }
+  list BO=W,J,bvec,E,abb,v,w,intE;
+  return(BO);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y,z),dp;
+   ideal J=x2-y3;
+   createBO(J,ideal(z));
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc blowUp(ideal J,ideal C,list #)
+"USAGE:  blowUp(J,C[,W][,E]);
+@*       J,C,W = ideals
+@*       E     = list
+ASSUME:  J  = ideal containing W ( W = 0 if not specified)
+@*       C  = ideal containing J
+@*       E  = list of smooth hypersurfaces (e.g. exceptional divisors)
+COMPUTE: the blowing up of W in C, the exceptional locus, the strict transform
+@*       of J
+RETURN:  list of size at most size(C),
+         l[i] is a ring containing a basic object BO:
+         BO[1] an ideal, say Wi, defining the ambient space of the i-th chart
+               of the blowing up
+         BO[2] an ideal defining the strict transform
+         BO[3] intvec, the first integer b such that in the original object
+               (Delta^b(BO[2]))==1
+               the subsequent integers have the same property for Coeff-Objects
+               of BO[2] used when determining the center
+         BO[4] the list of exceptional divisors
+         BO[5] an ideal defining the map K[W] ----> K[Wi]
+         BO[6] an intvec BO[6][j]=1 indicates that <BO[4][j],BO[2]>=1, i.e. the
+               strict transform does not meet the j-th exceptional divisor
+         BO[7] intvec,
+               the index of the first blown-up object in the resolution process
+               leading to this object for which the value of b was BO[3]
+               the subsequent ones are the indices for the Coeff-Objects
+               of BO[2] used when determining the center
+         BO[8] a matrix indicating that BO[4][i] meets BO[4][j] by BO[8][i,j]=1
+               for i < j
+EXAMPLE: example blowUp;  shows an example
+"
+{
+  ideal W;
+  list E;
+  ideal abb=maxideal(1);
+  intvec v;
+  intvec bvec;
+  intvec w=-1;
+  matrix intE;
+  if(size(#)>0)
+  {
+    if(typeof(#[1])=="ideal")
+    {
+      W=#[1];
+    }
+    if(typeof(#[1])=="list")
+    {
+      E=#[1];
+    }
+    if(size(#)>1)
+    {
+      if((typeof(#[2])=="list") && (size(E)==0))
+      {
+        E=#[2];
+      }
+      if((typeof(#[2])=="ideal") && (size(W)==0))
+      {
+        W=#[2];
+      }
+    }
+  }
+  list BO=W,J,bvec,E,abb,v,w,intE;
+  int locaT;
+  export locaT;
+  list blow=blowUpBO(BO,C,0);
+  kill locaT;
+  return(blow);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y),dp;
+   ideal J=x2-y3;
+   ideal C=x,y;
+   list blow=blowUp(J,C);
+   def Q=blow[1];
+   setring Q;
+   BO;
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc Center(ideal J,list #)
+"USAGE:  Center(J[,W][,E])
+@*       J,W = ideals
+@*       E   = list
+ASSUME:  J  = ideal containing W ( W = 0 if not specified)
+@*       E  = list of smooth hypersurfaces (e.g. exceptional divisors)
+COMPUTE: the center of the blow-up of J for the resolution algorithm
+         of [Bravo,Encinas,Villamayor]
+EXAMPLE: example Center;  shows an example
+"
+{
+  ideal W;
+  list E;
+  ideal abb=maxideal(1);
+  intvec v;
+  intvec bvec;
+  intvec w=-1;
+  matrix intE;
+  if(size(#)>0)
+  {
+    if(typeof(#[1])=="ideal")
+    {
+      W=#[1];
+    }
+    if(typeof(#[1])=="list")
+    {
+      E=#[1];
+    }
+    if(size(#)>1)
+    {
+      if((typeof(#[2])=="list") && (size(E)==0))
+      {
+        E=#[2];
+      }
+      if((typeof(#[2])=="ideal") && (size(W)==0))
+      {
+        W=#[2];
+      }
+      if(size(#)==3){bvec=#[3];}
+    }
+  }
+
+  list BO=W,J,bvec,E,abb,v,w,intE,intvec(0);
+  if(defined(invSat)){kill invSat;}
+  list invSat=ideal(0),intvec(0);
+  export(invSat);
+
+  list re=CenterBO(BO);
+  ideal cent=re[1];
+  return(cent);
+}
+example
+{  "EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y),dp;
+   ideal J=x2-y3;
+   Center(J);
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc blowUpBO(list BO, ideal C,int e)
+"USAGE:  blowUpBO (BO,C,e);
+@*       BO = basic object, a list: ideal W,
+@*                                  ideal J,
+@*                                  intvec b,
+@*                                  list Ex,
+@*                                  ideal ab,
+@*                                  intvec v,
+@*                                  intvec w,
+@*                                  matrix M
+@*       C  = ideal
+@*       e  = integer (0 usual blowing up, 1 deleting extra charts, 2 deleting
+@*            no charts )
+ASSUME:  R  = basering, a polynomial ring, W an ideal of R,
+@*       J  = ideal containing W,
+@*       C  = ideal containing J
+COMPUTE: the blowing up of BO[1] in C, the exeptional locus, the strict
+         transform of BO[2]
+NOTE:    blowUpBO may be applied to basic objects in the sense of
+@*       [Bravo, Encinas, Villamayor] in the following referred to as BO and
+@*       to presentations in the sense of [Bierstone, Milman] in the following
+@*       referred to as BM.
+RETURN:  a list l of length at most size(C),
+         l[i] is a ring containing an object BO resp. BM:
+         BO[1]=BM[1] an ideal, say Wi, defining the ambient space of the
+               i-th chart of the blowing up
+         BO[2]=BM[2] an ideal defining the strict transform
+         BO[3] intvec, the first integer b such that in the original object
+               (Delta^b(BO[2]))==1
+               the subsequent integers have the same property for Coeff-Objects
+               of BO[2] used when determining the center
+         BM[3] intvec, BM[3][i] is the assigned multiplicity of BM[2][i]
+         BO[4]=BM[4] the list of exceptional divisors
+         BO[5]=BM[5] an ideal defining the map K[W] ----> K[Wi]
+         BO[6]=BM[6] an intvec BO[6][j]=1 indicates that <BO[4][j],BO[2]>=1,
+               i.e. the strict transform does not meet the j-th exceptional
+               divisor
+         BO[7] intvec,
+               the index of the first blown-up object in the resolution process
+               leading to this object for which the value of b was BO[3]
+               the subsequent ones are the indices for the Coeff-Objects
+               of BO[2] used when determining the center
+         BM[7] intvec, BM[7][i] is the index at which the (2i-1)st entry
+               of the invariant first reached its current maximal value
+         BO[8]=BM[8] a matrix indicating that BO[4][i] meets BO[4][j] by
+               BO[8][i,j]=1 for i < j
+         BO[9] empty
+         BM[9] the invariant
+
+EXAMPLE: example blowUpBO;  shows an example
+"
+{
+//---------------------------------------------------------------------------
+// Initialization  and sanity checks
+//---------------------------------------------------------------------------
+   def R0=basering;
+   if(!defined(locaT)){int locaT;}
+   if(locaT){poly pp=@p;}
+   intvec v;
+   int shortC=defined(shortcut);
+   int invS=defined(invSat);
+   int eq,hy;
+   int extra,noDel,keepDiv;
+   if(e==1){extra=1;}
+//---keeps all charts
+   if(e==2){noDel=1;}
+//---this is only for curves and surfaces
+//---keeps all charts with relevant informations on the exceptional divisors
+   if(e==3){keepDiv=1;}
+   if( typeof(attrib(BO[2],"isEqui"))=="int" )
+   {
+      eq=attrib(BO[2],"isEqui");
+   }
+   if( typeof(attrib(BO[2],"isHy"))=="int" )
+   {
+      hy=attrib(BO[2],"isHy");
+   }
+   string newvar;
+   int n=nvars(R0);
+   int i,j,l,m,x,jj,ll,haveCenters,co;
+//---the center should neither be the whole space nor empty
+   if((size(C)==0)||(deg(C[1])==0))
+   {
+      list result=R0;
+      return(result);
+   }
+   if(!defined(debugBlowUp))
+   {
+     int debugBlowUp=0;
+   }
+//---------------------------------------------------------------------------
+// Drop unnecessary variables
+//---------------------------------------------------------------------------
+//---step 1: substitution
+   if(!((keepDiv)||(noDel)))
+   {
+//!!! in case keepDiv and noDel:
+//!!! maybe simplify the situation by an appropriate coordinate change
+//!!! of this kind -- without dropping variables?
+      list L=elimpart(BO[1]);
+      if(size(L[2])!=0)
+      {
+         map psi=R0,L[5];
+         C=psi(C);
+         BO=psi(BO);
+      }
+
+      if(size(BO[1])==0)
+      {
+         ideal LL;
+         for(j=1;j<=size(BO[4]);j++)
+         {
+            LL=LL,BO[4][j];
+         }
+         LL=findvars(LL);
+         L=elimpart(BO[2]);
+         if((size(L[2])!=0)&&(size(std(LL+L[2]))==size(L[2])+size(LL)))
+         {
+            map chi=R0,L[5];
+            C=chi(C);
+            BO=chi(BO);
+         }
+      }
+//---step 2: dropping non-occurring variables
+      int s=size(C);
+      ideal K=BO[1],BO[2],C;
+      for(j=1;j<=size(BO[4]);j++)
+      {
+        K=K,BO[4][j];
+      }
+      list N=findvars(K,0);
+      if(size(N[1])<n)
+      {
+         newvar=string(N[1]);
+         v=N[4];
+         for(j=1;j<=size(v);j++){BO[5]=subst(BO[5],var(v[j]),0);}
+         execute("ring R1=("+charstr(R0)+"),("+newvar+"),dp;");
+         list BO=imap(R0,BO);
+         ideal C=imap(R0,C);
+         n=nvars(R1);
+      }
+      else
+      {
+         def R1=basering;
+      }
+   }
+   else
+   {
+     int s=size(C);
+     def R1=basering;
+   }
+   if(debugBlowUp)
+   {
+     "---> In BlowUp: After dropping unnecessary variables";
+     "BO:";
+     BO;
+     "C:";
+     C;
+   }
+//---------------------------------------------------------------------------
+// Do the actual blow-up
+//---------------------------------------------------------------------------
+//--- control the names of the variables
+   execute("ring R=("+charstr(R0)+"),(x(1..n)),dp;");
+   list BO=fetch(R1,BO);
+   ideal C=fetch(R1,C);
+   list Cmstd=mstd(C);
+   C=Cmstd[2];
+   if(size(Cmstd[1])<=size(Cmstd[2]))
+   {
+      C=Cmstd[1];
+   }
+   else
+   {
+      C=interred(C);
+   }
+   list result;
+//--- the blow-up process
+   ideal W  =BO[1];
+   ideal J  =BO[2];
+   intvec bvec  =BO[3];
+   list Ex  =BO[4];
+   ideal abb=BO[5];
+   intvec wvec=BO[7];
+   ideal laM=maxideal(1);
+   if((typeof(BO[9])=="intmat")||(typeof(BO[9])=="intvec"))
+   {
+      def @invmat=BO[9];
+   }
+   if(size(BO)>9)
+   {
+//--- check whether a previous center had been split into connected components
+      if(size(BO[10])>0)
+      {
+         list knownCenters=BO[10];
+         haveCenters=1;
+       }
+   }
+
+   matrix intE=BO[8];
+   Ex[size(Ex)+1]=var(1);
+         //to have the list depending on R in case BO[4] is empty
+
+   execute("ring S=("+charstr(R)+"),("+varstr(R)+",y(0..s-1)),dp;");
+   list resu;
+   list B;
+   execute("ring T=("+charstr(R)+"),("+varstr(R)+",y(0..s-1),t),dp;");
+   ideal C=imap(R,C);
+   ideal W=imap(R,W);
+   execute("map phi=S,"+varstr(R)+",t*C;")
+   setring S;
+
+//--- the ideal describing the blow-up map
+   ideal abb=imap(R,abb);
+   ideal laM0=imap(R,laM);
+//--- the ideal of the blowing up of the ambient space
+   ideal W=preimage(T,phi,W);
+//--- the ideal of the exceptional locus
+   ideal E=imap(R,C);
+
+   list E1=imap(R,Ex);
+   E1[size(E1)]=E;
+   ideal J=imap(R,J)+W;
+
+   if(haveCenters){list kN=imap(R,knownCenters);}
+
+//---  the strict transform of the exceptional divisors
+   for(j=1;j<size(E1);j++){E1[j]=sat(E1[j]+W,E)[1];}
+//---  the intersection matrix of the exceptional divisors
+   matrix intEold=imap(R,intE);
+   matrix intE[size(E1)][size(E1)];
+   ideal U,Jsub,sLstd;
+
+   for(j=1;j<size(E1);j++)
+   {
+       for(l=j+1;l<=size(E1);l++)
+       {
+          if(deg(E1[j][1])==0)
+          {
+             if(l<size(E1)){intE[j,l]=intEold[j,l];}
+             else             {intE[j,l]=0;}
+          }
+          else
+          {
+             if(deg(E1[l][1])==0)
+             {
+                if(l<size(E1)){intE[j,l]=intEold[j,l];}
+             }
+             else
+             {
+                U= std(E1[l]+E1[j]);
+                if(dim(U)>0){intE[j,l]=1;}
+                else        {intE[j,l]=0;}
+             }
+          }
+       }
+   }
+   if(debugBlowUp)
+   {
+     "----> In BlowUp: After Blowing-up, before Clean-Up";
+     "W:";
+     W;
+     "J:";
+     J;
+   }
+//----------------------------------------------------------------------------
+// generating and cleaning up the different charts
+//----------------------------------------------------------------------------
+   list M;
+   map psi;
+   list E2;
+   ideal K,JJ,laM,LL,MM;
+   n=nvars(S);
+   list N;
+   list Bstd;
+   intvec delCharts,extraCharts;
+   delCharts[s]=0;
+   extraCharts[s]=0;
+   ideal MA=y(0..s-1);
+   list ZRes,ZlaM,ZsLstd;
+   for(i=0;i<=s-1;i++)
+   {
+     if(haveCenters)
+     {
+        B[10]=kN;
+        for(j=1;j<=size(kN);j++)
+        {
+           B[10][j][1]=subst(B[10][j][1],y(i),1);
+        }
+     }
+     B[8]=intE;
+     B[1]=std(subst(W,y(i),1));
+     if(deg(B[1][1])==0)
+     {
+//--- subsets of the empty set are not really interesting!
+       delCharts[i+1]=1;
+       ZRes[i+1]=B;
+       ZlaM[i+1]=laM;
+       i++;
+       continue;
+     }
+     Jsub=subst(J,y(i),1);
+     attrib(Jsub,"isEqui",eq);
+     attrib(Jsub,"isHy",hy);
+     B[2]=Jsub;
+     B[3]=bvec;
+     for(j=1;j<size(E1);j++){E2[j]=subst(E1[j],y(i),1);}
+     E2[size(E1)]=E+B[1];
+     B[4]=E2;
+     M=elimpart(B[1]);
+     B[5]=abb;
+     laM=laM0;
+     psi=S,maxideal(1);
+     if(size(M[2])!=0)
+     {
+        psi=S,M[5];
+        B=psi(B);
+        laM=psi(laM);
+     }
+     Jsub=B[2];
+     B[2]=sat(Jsub,std(psi(E)))[1];
+     if(!defined(MAtmp)){ideal MAtmp=MA;}
+     MAtmp[i+1]=0;
+     JJ=std(B[2]+MAtmp);
+     if(deg(JJ[1])==0)
+     {
+        delCharts[i+1]=1;
+//--- the i-th chart will be marked for deleting because all informations
+//--- are already contained in the union of the remaining charts
+     }
+     else
+     {
+        if((eq)&&(dim(JJ)<dim(std(B[2]))))
+        {
+           extraCharts[i+1]=1;
+//---  compute the singular locus
+           if((B[3][1]<=1)&&(hy))
+//--- B[2] is a smooth hypersurface
+           {
+              sLstd=ideal(1);
+           }
+           else
+           {
+              Bstd=mstd(B[2]);
+              if(n-dim(Bstd[1])>4)
+              {
+//--- in this case the singular locus is too complicated
+                 sLstd=ideal(0);
+              }
+              JJ=Bstd[2];
+              attrib(JJ,"isEqui",eq);
+              B[2]=JJ;
+              sLstd=slocusE(B[2]);
+           }
+           m=0;
+           if(deg(std(sLstd+MAtmp)[1])==0)
+           {
+//--- the singular locus of B[2] is in the union of the remaining charts
+              m=1;
+              for(l=1;l<=size(B[4]);l++)
+              {
+                 if(deg(std(B[2]+B[4][l]+MAtmp)[1])!=0)
+                 {
+//--- the exceptional divisor meets B[2] at the locus of MAtmp
+//--- we continue only if the option extra=1 and we have transversal
+//--- intersection
+                    m=0;
+                    break;
+                  }
+              }
+           }
+           if(m)
+           {
+//--- the i-th chart will be marked for deleting because all informations
+//--- are already contained in the union of the remaining charts
+              delCharts[i+1]=1;
+           }
+        }
+     }
+     if(delCharts[i+1]==0)
+     {
+        MAtmp[i+1]=MA[i+1];
+        ZsLstd[i+1]=sLstd;
+     }
+     ZRes[i+1]=B;
+     ZlaM[i+1]=laM;
+   }
+//---------------------------------------------------------------------------
+// extra = ignore uninteresting charts even if there is a normal
+//         crosssing intersection in it
+//---------------------------------------------------------------------------
+   if(extra)
+   {
+      for(i=0;i<=s-1;i++)
+      {
+         if((delCharts[i+1]==0)&&(extraCharts[i+1]))
+         {
+           MAtmp[i+1]=0;
+           B=ZRes[i+1];
+           sLstd=ZsLstd[i+1];
+           m=0;
+           if(deg(std(sLstd+MAtmp)[1])==0)
+           {
+//--- the singular locus of B[2] is in the union of the remaining charts
+              m=1;
+              for(l=1;l<=size(B[4]);l++)
+              {
+                 if(deg(std(B[2]+B[4][l]+MAtmp)[1])!=0)
+                 {
+//--- the exceptional divisor meets B[2] at the locus of MAtmp
+//--- we continue only if the option extra=1 and we have transversal
+//--- intersection
+                    m=2;
+                    if(!transversalTB(B[2],list(B[4][l]),MAtmp))
+                    {
+                       m=0;break;
+                    }
+                  }
+              }
+           }
+           if(m)
+           {
+              if(m==1)
+              {
+//--- the i-th chart will be marked for deleting because all informations
+//--- are already contained in the union of the remaining charts
+                 delCharts[i+1]=1;
+              }
+              else
+              {
+//--- the option extra=1 and we have transversal intersection
+//--- we delete the chart in case of normal crossings
+                 if(normalCrossB(B[2],B[4],MAtmp))
+                 {
+//--- in case of the option extra
+//--- the i-th chart will be marked for deleting because all informations
+//--- are already contained in the union of the remaining charts
+
+                   delCharts[i+1]=1;
+                 }
+              }
+           }
+           if(delCharts[i+1]==0)
+           {
+              MAtmp[i+1]=MA[i+1];
+           }
+         }
+      }
+      for(i=0;i<=s-1;i++)
+      {
+         if(!delCharts[i+1]){break;}
+      }
+      if(i==s){delCharts[s]=0;}
+   }
+   for(i=0;i<=s-1;i++)
+   {
+     B=ZRes[i+1];
+     laM=ZlaM[i+1];
+     if(noDel){delCharts[i+1]=0;}
+//---keeps chart if the exceptional divisor is not in any other chart
+     if((delCharts[i+1])&&(keepDiv))
+     {
+         for(j=1;j<=size(B[4]);j++)
+         {
+            if(deg(std(B[4][j])[1])>0)
+            {
+               x=0;
+               for(l=0;l<=s-1;l++)
+               {
+                  if((l!=i)&&(!delCharts[l+1])&&(deg(std(ZRes[l+1][4][j])[1])>0))
+                  {
+                     x=1;
+                     break;
+                  }
+               }
+               if(!x)
+               {
+                  delCharts[i+1]=0;
+//!!!evtl. diese Karten markieren und nicht weiter aufblasen???
+                  break;
+               }
+            }
+         }
+     }
+//---keeps charts if the intersection of 2 divisors is not in any other chart
+     if((delCharts[i+1])&&(keepDiv))
+     {
+         for(j=1;j<=size(B[4])-1;j++)
+         {
+            for(l=j+1;l<=size(B[4]);l++)
+            {
+               if(deg(std(B[4][j]+B[4][l])[1])>0)
+               {
+                  x=0;
+                  for(ll=0;ll<=s-1;ll++)
+                  {
+                     if((ll!=i)&&(!delCharts[ll+1]))
+                     {
+                        if(deg(std(ZRes[ll+1][4][j]+ZRes[ll+1][4][l])[1])>0)
+                        {
+                           x=1;
+                           break;
+                        }
+                     }
+                  }
+                  if(!x)
+                  {
+                     delCharts[i+1]=0;
+                     break;
+                  }
+               }
+            }
+            if(!delCharts[i+1]){break;}
+         }
+     }
+//---keeps charts if the intersection of 3 divisors is not in any other chart
+     if((delCharts[i+1])&&(keepDiv))
+     {
+         for(j=1;j<=size(B[4])-2;j++)
+         {
+            for(l=j+1;l<=size(B[4])-1;l++)
+            {
+               for(ll=l+1;ll<=size(B[4]);ll++)
+               {
+                  if(deg(std(B[4][j]+B[4][l]+B[4][ll])[1])>0)
+                  {
+                     x=0;
+                     for(jj=0;jj<=s-1;jj++)
+                     {
+                        if((jj!=i)&&(!delCharts[jj+1]))
+                        {
+                           if(deg(std(ZRes[jj+1][4][j]
+                              +ZRes[jj+1][4][l]+ZRes[jj+1][4][ll])[1])>0)
+                           {
+                              x=1;
+                              break;
+                           }
+                        }
+                     }
+                     if(!x)
+                     {
+                       delCharts[i+1]=0;
+                       break;
+                     }
+                  }
+               }
+               if(!delCharts[i+1]){break;}
+            }
+            if(!delCharts[i+1]){break;}
+        }
+     }
+     if(delCharts[i+1]==0)
+     {
+//--- try to decrease the number of variables by substitution
+        if((!keepDiv)&&(!noDel))
+        {
+           list WW=elimpart(B[1]);
+           map phiW=basering,WW[5];
+           B=phiW(B);
+           laM=phiW(laM);
+           kill WW;
+           kill phiW;
+           if(size(B[1])==0)
+           {
+              LL=0;
+              for(j=1;j<=size(B[4]);j++)
+              {
+                 MM=std(B[4][j]);
+                 if(deg(MM[1])>0){LL=LL,MM;}
+              }
+              LL=findvars(LL);
+              M=elimpart(B[2]);
+              if((size(M[2])!=0)&&(size(std(LL+M[2]))==size(M[2])+size(LL)))
+              {
+                psi=S,M[5];
+                B=psi(B);
+                laM=psi(laM);
+              }
+           }
+         }
+//---- interreduce B[1],B[2] and all B[4][j]
+        B[1]=interred(B[1]);
+        B[2]=interred(B[2]);
+        E2=B[4];
+        for(j=1;j<=size(E2);j++){E2[j]=interred(E2[j]);}
+        B[4]=E2;
+        v=0;v[size(E2)]=0;
+//--- mark those j for which B[4] does not meet B[2]
+        for(j=1;j<=size(E2);j++)
+        {
+            K=E2[j],B[2];
+            K=std(K);
+            if(deg(K[1])==0)
+            {
+              v[j]=1;
+            }
+        }
+        B[6]=v;
+        B[7]=wvec;
+//--- throw away variables which do not occur
+        K=B[1],B[2],B[5];          //Aenderung!!!
+        for(j=1;j<=size(B[4]);j++){K=K,B[4][j];}
+        N=findvars(K,0);
+        if(size(N[1])<n)
+        {
+           newvar=string(N[1]);
+           v=N[4];
+           for(j=1;j<=size(v);j++)
+           {
+              B[5]=subst(B[5],var(v[j]),0);
+              laM=subst(laM,var(v[j]),0);
+           }
+           execute("ring R2=("+charstr(S)+"),("+newvar+"),dp;");
+           list BO=imap(S,B);
+           ideal laM=imap(S,laM);
+        }
+        else
+        {
+           def R2=basering;
+           list BO=B;
+        }
+        ideal JJ=BO[2];
+        attrib(JJ,"isEqui",eq);
+        attrib(JJ,"isHy",hy);
+        BO[2]=JJ;
+//--- strict transforms of the known centers
+        if(haveCenters)
+        {
+           ideal tt;
+           list tList;
+           for(j=1;j<=size(BO[10]);j++)
+           {
+              tt=std(BO[10][j][1]);
+              if(deg(tt[1])>0)
+              {
+                tt=sat(tt,BO[4][size(BO[4])])[1];
+              }
+              if((deg(tt[1])>0)&&(deg(std(tt+BO[2]+BO[1])[1])>0))
+              {
+                 tList[size(tList)+1]=
+                            list(tt,BO[10][j][2],BO[10][j][3],BO[10][j][4]);
+              }
+           }
+           BO[10]=tList;
+           kill tList;
+        }
+//--- marking  variables which do not occur in BO[1] and BO[2]
+//--- and occur in exactly one BO[4][j], which is the hyperplane given by
+//--- this variable
+//!!!! not necessarily in exactly one BO[4][j]
+        list N=findvars(BO[1]+BO[2],0);
+        if(size(N[1])<nvars(basering))
+        {
+           v=N[4];
+           if(defined(H)){kill H;}
+           if(defined(EE)){kill EE;}
+           if(defined(vv)){kill vv;}
+           list EE;
+           intvec vv;
+           ideal H=maxideal(1);
+           for(j=1;j<=size(v);j++)
+           {
+             H[v[j]]=0;
+           }
+           H=std(H);
+           for(l=1;l<=size(BO[4]);l++)
+           {
+              if(BO[6][l]==1){l++;continue;}
+              if(size(ideal(reduce(BO[4][l],H)-BO[4][l]))==0)
+              {
+//!!! need further cleanup:
+//!!! this part of the code is no longer used since it did not glue properly
+//                 BO[6][l]=2;
+                 EE[size(EE)+1]=BO[4][l];
+                 vv[size(vv)+1]=l;
+              }
+           }
+           if((size(vv)>dim(std(BO[2])))&&(deg(BO[2][1])>0))
+           {
+              list BOtemp3=BO;
+              BOtemp3[4]=EE;
+              intvec ivtemp3;
+              ivtemp3[size(BOtemp3[4])]=0;
+              BOtemp3[6]=ivtemp3;
+              BOtemp3[7][1]=-1;
+              list iEtemp3=inters_E(BOtemp3);
+              if(iEtemp3[2]>=dim(std(BOtemp3[2])))
+              {
+                 for(l=2;l<=size(vv);l++)
+                 {
+                    BO[6][vv[l]]=0;
+                 }
+              }
+              kill BOtemp3,ivtemp3,iEtemp3;
+           }
+        }
+        list thisChart=ideal(0),i;
+        export thisChart;
+
+//----------------------------------------------------------------------------
+// export the basic object and append the ring to the list of rings
+//----------------------------------------------------------------------------
+        if(debugBlowUp)
+        {
+           "----> In BlowUp: Adding a single chart";
+           "BO:";
+           BO;
+        }
+        if(locaT)
+        {
+           map locaPhi=R0,laM;
+           poly @p=locaPhi(pp);
+           export(@p);
+        }
+        ideal lastMap=laM;
+        export lastMap;
+        if(invS){list invSat=imap(R0,invSat);export invSat;}
+        if(defined(@invmat)){BO[9]=@invmat;}
+        if(shortC){list shortcut=imap(R0,shortcut);export(shortcut);}
+        export BO;
+        result[size(result)+1]=R2;
+        setring S;
+        kill R2;
+     }
+   }
+   setring R0;
+   return(result);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y),dp;
+
+   ideal W;
+   ideal J=x2-y3;
+   intvec b=1;
+   list E;
+   ideal abb=maxideal(1);
+   intvec v;
+   intvec w=-1;
+   matrix M;
+   intvec ma;
+   list BO=W,J,b,E,abb,v,w,M,ma;
+
+   ideal C=CenterBO(BO)[1];
+
+   list blow=blowUpBO(BO,C,0);
+   def Q=blow[1];
+   setring Q;
+   BO;
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc slocusE(ideal i)
+"Internal procedure - no help and no example available
+"
+{
+//--- do slocus in equidimensional case directly -- speed up
+  if(size(i)==0){return(ideal(1));}
+  if( typeof(attrib(i,"isEqui"))=="int" )
+  {
+     if(attrib(i,"isEqui")==1)
+     {
+        ideal j=std(i);
+        if(deg(j[1])==0){return(j);}
+        int cod  = nvars(basering)-dim(j);
+        i        = i+minor(jacob(i),cod);
+        return(i);
+     }
+  }
+  return(slocus(i));
+}
+///////////////////////////////////////////////////////////////////////////////
+static
+proc inters_E(list BO)
+"USAGE:  inters_E(BO);
+@*       BO = basic object, a list: ideal W,
+@*                                  ideal J,
+@*                                  intvec b,
+@*                                  list Ex,
+@*                                  ideal ab,
+@*                                  intvec v,
+@*                                  intvec w,
+@*                                  matrix M
+ASSUME:  R  = basering, a polynomial ring, W an ideal of R,
+@*       J  = ideal containing W,
+@*       BO in the setting of case 2 of [Bravo,Encinas,Villamayor]
+@*             BO[4]=E, BO[4][1..count]=E^-
+@*             BO[7][1]=count
+COMPUTE: (W,(P,1),E^+) in the notation of [Bravo,Encinas,Villamayor]
+RETURN:  a list l ,
+         l[1]: P = product of ideals I(H_i1)+..+I(H_in) over all
+                   n-tuples of indices i1..in from 1..count
+         l[2]: n = maximal number of H_i from E^- meeting J simultaneously
+         l[3]: maximal number of H_i from E meeting J simultaneously
+EXAMPLE: internal procedure - no example available
+"
+{
+//---------------------------------------------------------------------
+// Initialization
+//---------------------------------------------------------------------
+  int kk,jj,ii,updated,n,count2,kkdiff;
+  def rb=basering;
+  def W=BO[1];
+  ideal J=BO[1],BO[2];
+  int nonnormal;
+  int maxkk=dim(std(J));
+  int dimJ=maxkk;
+  ideal test2;
+  list merklist1,merklist2;
+  if(size(BO[4])==0)
+  {
+    list retlist=BO[2],n;
+    return(retlist);
+  }
+  def E=BO[4];
+  intvec stoplist=BO[6];
+//--- fill in all known information about exceptional divisors not meeting
+//--- current chart
+  for(ii=1;ii<=size(E);ii++)
+  {
+    if(deg(std(E[ii])[1])==0)
+    {
+      stoplist[ii]=1;
+    }
+  }
+
+  int count=BO[7][1];
+  if(!defined(debug_Inters_E))
+  {
+    int debug_Inters_E=0;
+  }
+//---------------------------------------------------------------------
+// we only want to look at E^-, not at all of E
+//---------------------------------------------------------------------
+  if (count>-1)
+  {
+    if (count>0)
+    {
+      list E_new=E[1..count];
+      count2=size(E);
+    }
+    else
+    {
+      list E_new;
+      count2=size(E);
+    }
+  }
+  else
+  {
+    list E_new=E;
+    count=size(E_new);
+    count2=count;
+  }
+//---------------------------------------------------------------------
+// combinatorics is expensive in an interpreted language,
+// we leave it to the kernel by translating it into monomial
+// ideals in a new ring with variables t(i)
+//---------------------------------------------------------------------
+  string rstr="ring rcomb=0,(t(1.." + string(size(E)) + ")),dp;";
+  execute(rstr);
+  ideal potid,potid2;
+  list monlist,comblist,merkmon;
+  for(kk=1;kk<=count;kk++)
+  {
+    if(stoplist[kk]==0)
+    {
+//**************************************************************************/
+// it does not make sense to intersect twice by the same E_i
+// ===> reduce by t(i)^2
+//**************************************************************************/
+      potid=potid,t(kk)^2;
+    }
+    else
+    {
+//**************************************************************************/
+// it does not make sense to consider E_i with v[i]==1 ===> reduce by t(i)
+//**************************************************************************/
+      potid=potid,t(kk);
+//**************************************************************************/
+// if stoplist[kk]==2 then J and all E_i automatically intersect E_kk
+// hence we need not test it, but we have to lower maxkk by one
+//**************************************************************************/
+      if(stoplist[kk]==2)
+      {
+        maxkk=maxkk-1;
+        kkdiff++;             // count these for dimension check later on
+
+      }
+    }
+  }
+
+  potid2=std(potid);
+  if(count2>count)
+  {
+    potid=potid,t((count+1)..count2);
+    for(kk=max(1,count);kk<=count2;kk++)
+    {
+      potid2=potid2,t(kk)^2;
+    }
+  }
+  potid=std(potid);
+  potid2=std(potid2);
+  for(kk=1;(((kk<=count)||(kk<=maxkk+1))&&(kk<=count2));kk++)
+  {
+//-------------------------------------------------------------------------
+// monlist[kk]=lists of kk entries of E_new, not containing an E_i twice,
+// not containing an E_i where v[i]==1
+//-------------------------------------------------------------------------
+    monlist[kk]=redMax(kk,potid);
+//*************************************************************************/
+// in the case of n<=maxkk we also need to know whether n would still be
+// below this bound if we considered all of E instead of E_new
+// ===> merkmon contains previously ignored tuples E_i1,..,E_im
+//*************************************************************************/
+    if(kk<=maxkk+1)
+    {
+      merkmon[kk]=redMax(kk,potid2);
+      merkmon[kk]=simplify(reduce(merkmon[kk],std(monlist[kk])),2);
+    }
+  }
+  if(debug_Inters_E)
+  {
+    "----> In Inters_E: the tuples";
+    "tuples of E^-:";
+    monlist;
+    "the remaining tuples:";
+    merkmon;
+  }
+//-------------------------------------------------------------------------
+// check whether there is a kk-tuple of E_i intersecting J,
+// kk running from 1 to count
+//-------------------------------------------------------------------------
+  for(kk=1;kk<=count;kk++)
+  {
+    if(size(monlist[kk]==0)) break;
+    kill comblist;
+    list comblist;
+//--- transscribe the tuples from monomial notation to intvec notation
+    for(jj=1;jj<=ncols(monlist[kk]);jj++)
+    {
+      comblist[jj]=leadexp(monlist[kk][jj]);
+    }
+    setring rb;
+    updated=0;
+//------------------------------------------------------------------------
+// Do the intersections
+//------------------------------------------------------------------------
+    for(jj=1;jj<=size(comblist);jj++)
+    {
+//--- jj-th tuple from list of tuples of kk E_i
+      test2=J;
+      for(ii=1;ii<=count;ii++)
+      {
+        if(comblist[jj][ii]==1)
+        {
+          test2=test2,E_new[ii];
+        }
+      }
+      test2=std(test2);
+//--- check whether this intersection is non-empty and store it accordingly
+      if(deg(test2[1])!=0)
+      {
+//--- it is non-empty
+        if(updated!=0)
+        {
+          merklist1[size(merklist1)+1]=comblist[jj];
+        }
+        else
+        {
+          kill merklist1;
+          list merklist1;
+          merklist1[1]=comblist[jj];
+          updated=1;
+          n=kk;
+        }
+        if(dim(test2)!=maxkk-kk+kkdiff)
+        {
+          nonnormal=1;
+        }
+      }
+      else
+      {
+//--- it is empty
+        merklist2[size(merklist2)+1]=jj;
+      }
+    }
+    setring rcomb;
+    ideal redid;
+//---------------------------------------------------------------------
+// update monlist and merkmon by the knowledge what intersections are
+// empty in the kk-th step
+//---------------------------------------------------------------------
+    for(jj=1;jj<=size(merklist2);jj++)
+    {
+      redid=redid,monlist[kk][merklist2[jj]];
+    }
+    for(jj=kk+1;jj<=count;jj++)
+    {
+      monlist[jj]=simplify(reduce(monlist[jj],std(redid)),2);
+      if(jj<=maxkk+1)
+      {
+        merkmon[jj]=simplify(reduce(merkmon[jj],std(redid)),2);
+      }
+    }
+    kill redid;
+    kill merklist2;
+    list merklist2;
+  }
+  if(debug_Inters_E)
+  {
+    "----> In Inters_E: intersections found:";
+    merklist1;
+  }
+//---------------------------------------------------------------------
+// form the union of the intersections of the appropriate E_i
+//---------------------------------------------------------------------
+  setring rb;
+  ideal center,dummy;
+  list centlist;
+  for(kk=1;kk<=size(merklist1);kk++)
+  {
+    for(jj=1;jj<=size(merklist1[kk]);jj++)
+    {
+      if(merklist1[kk][jj]==1)
+      {
+        dummy=dummy,E_new[jj];
+      }
+    }
+    if(size(center)==0)
+    {
+      center=dummy;
+      centlist[1]=dummy;
+    }
+    else
+    {
+      center=intersect(center,dummy);
+      centlist[size(centlist)+1]=dummy;
+    }
+    dummy=0;
+  }
+  if(debug_Inters_E)
+  {
+    "----> In Inters_E: intersection of E_i";
+    "maximal number of E_i encountered in:";
+    center;
+    "the components of this locus:";
+    centlist;
+    "maximal number of E_i from E^- intersecting simultaneously:",n;
+    if(nonnormal)
+    {
+      "flag nonnormal is set";
+    }
+  }
+  list retlist=center,n;
+//-------------------------------------------------------------------------
+// If n<=maxkk, then test if this is the case for all of E not just E_new
+// using the pairs indicated by merkmon
+//-------------------------------------------------------------------------
+  int ntotal=n;
+  if((n<=maxkk)&&(n<count2)&&(!nonnormal))
+  {
+//--- check kk-tuples
+    for(kk=n+1;kk<=maxkk+1;kk++)
+    {
+      setring rcomb;
+//--- check if there are combinations to be checked
+      if(kk>size(merkmon))
+      {
+        setring rb;
+        break;
+      }
+      if(size(merkmon[kk])!=0)
+      {
+        kill comblist;
+        list comblist;
+//--- transscribe tuples from  monomial notation to intvec notation
+        for(jj=1;jj<=size(merkmon[kk]);jj++)
+        {
+          comblist[jj]=leadexp(merkmon[kk][jj]);
+        }
+        setring rb;
+//--- check jj-th tuple from the list of kk-tuples
+        for(jj=1;jj<=size(comblist);jj++)
+        {
+          test2=J;
+          for(ii=1;ii<=nvars(rcomb);ii++)
+          {
+            if(comblist[jj][ii]==1)
+            {
+              test2=test2,E[ii];
+            }
+          }
+          test2=std(test2);
+//--- as soon as we found one we can proceed to the subsequent kk
+          if(deg(test2[1])!=0)
+          {
+            ntotal=kk;
+            if(dim(test2)-kkdiff!=maxkk-kk)
+            {
+              nonnormal=2;
+              break;
+            }
+          }
+        }
+//--- if we already know that too many E_i intersect simultaneously,
+//--- we need not proceed any further
+        if(nonnormal)
+        {
+          break;
+        }
+      }
+      else
+      {
+        setring rb;
+        break;
+      }
+    }
+  }
+//-------------------------------------------------------------------------
+// update the result accordingly and return it
+//-------------------------------------------------------------------------
+  if(maxkk<dimJ)
+  {
+    n=n+dimJ-maxkk;
+    ntotal=ntotal+dimJ-maxkk;
+  }
+  retlist[2]=n;
+  retlist[3]=ntotal;
+  if(n<=dimJ)
+  {
+    retlist[4]=centlist;
+    retlist[5]=merklist1;
+    if(nonnormal)
+    {
+      retlist[6]=nonnormal;
+    }
+  }
+  return(retlist);
+}
+///////////////////////////////////////////////////////////////////////////
+
+proc Delta(list BO)
+"USAGE:  Delta (BO);
+@*       BO = basic object, a list: ideal W,
+@*                                  ideal J,
+@*                                  intvec b,
+@*                                  list Ex,
+@*                                  ideal ab,
+@*                                  intvec v,
+@*                                  intvec w,
+@*                                  matrix M
+ASSUME:  R  = basering, a polynomial ring, W an ideal of R,
+@*       J  = ideal containing W
+COMPUTE: Delta-operator applied to J in the notation of
+         [Bravo,Encinas,Villamayor]
+RETURN:  ideal
+EXAMPLE: example Delta;  shows an example
+"
+{
+//---------------------------------------------------------------------------
+// Initialization  and sanity checks
+//---------------------------------------------------------------------------
+   ideal W=BO[1];
+   ideal J=BO[2];
+   ideal C=simplify(reduce(J,std(W)),2);
+   list LC;
+   int n=nvars(basering);
+//---------------------------------------------------------------------------
+// Simple case: W is the empty set
+//---------------------------------------------------------------------------
+   if(size(W)==0)
+   {
+      C=C,jacob(J);
+      C=std(C);
+      return(C);
+   }
+//---------------------------------------------------------------------------
+// General case: W is non-empty
+// Step 1: Find a minor of the Jacobian of W which is not identically zero
+//         and look at the complement of the zero-set given by this minor;
+//         this leads to the system of local parameters
+// Step 2: Form the derivatives w.r.t. this system of parameters
+//---------------------------------------------------------------------------
+//--- Step 1
+   list re=findMinor(W);
+   list L;
+   int ii,i,j,l,k;
+   J=C;
+   ideal D=ideal(1);
+   intvec v,w;
+   ideal V;
+   poly m;
+
+   for(ii=1;ii<=size(re);ii++)
+   {
+      C=J;
+      L=re[ii];
+      matrix A=L[1];  //(1/m)*A is the inverse matrix of the Jacobian of W
+                      //corresponding to m
+      m=L[2];  //a k- minor of jacob(W), not identically zero
+                      //k=n-dim(W)
+      V=L[3];  //the elements of W corresponding to m
+      v=L[4];  //the indices of variables corresponding to m
+      w=L[5];  //the indices of variables not corresponding to m
+
+//--- Step 2
+//--- first some initialization depending on results of step 1
+      k=size(V);
+      matrix dg[1][k];
+      matrix df[k][1];
+//--- derivatives of the generators of J w.r.t. system of parameters
+      for(i=1;i<=size(J);i++)
+      {
+         for(j=1;j<=n-k;j++)
+         {
+            for(l=1;l<=k;l++)
+            {
+               dg[1,l]=diff(V[l],var(w[j]));
+               df[l,1]=diff(J[i],var(v[l]));
+             }
+             C=C,m*diff(J[i],var(w[j]))-dg*A*df;
+         }
+      }
+//--- everything should live in W, not just in the intersection of
+//--- D(m) with W
+      C=C+W;
+      C=sat(C,m)[1];
+//--- intersect ideal with previously computed ones to make sure that no
+//--- components are lost
+      D=intersect(D,C);
+      kill dg,df,A;
+   }
+//--- return minimal set of generators of the result
+   list li=mstd(D);
+   D=li[2];
+   if(size(li[1])<=size(D)){D=li[1];}
+   return(D);
+}
+example
+{ "EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y,z),dp;
+
+   ideal W=z^2-x;
+   ideal J=x*y^2+x^3;
+   intvec b=1;
+   list E;
+   ideal abb=maxideal(1);
+   intvec v;
+   intvec w=-1;
+   matrix M;
+
+   list BO=W,J,b,E,abb,v,w,M;
+
+   Delta(BO);
+}
+
+//////////////////////////////////////////////////////////////////////////////
+static
+proc redMax(int k,ideal J)
+"Internal procedure - no help and no example available
+"
+{
+//--- reduce maxideal(k) by J, more efficient approach
+    int i;
+    ideal K=simplify(reduce(maxideal(1),J),2);
+    for(i=2;i<=k;i++)
+    {
+       K=simplify(reduce(K*maxideal(1),J),2);
+    }
+    return(K);
+}
+
+//////////////////////////////////////////////////////////////////////////////
+static
+proc findMinor(ideal W)
+"Internal procedure - no help and no example available
+"
+{
+//---------------------------------------------------------------------------
+// Initialization and sanity checks
+//---------------------------------------------------------------------------
+   list L;
+   intvec v,w;
+   ideal Wstd=std(W);
+   int n=nvars(basering);   // total number of columns of Jacobian
+   int k=n-dim(Wstd);       // size of minors of Jacobian
+   int a=size(W);           // total number of rows of Jacobian
+   matrix A[k][k];
+   list LW=indexSet(a,k);   // set of tuples of k rows
+   list LV=indexSet(n,k);   // set of tuples of k columns
+   ideal IW,IV;
+   int i,j,l,e;
+   list re;
+//---------------------------------------------------------------------------
+// We need to know which minor corresponds to which variable and to which
+// generator of W - therefore we cannot use the function minor()!
+//---------------------------------------------------------------------------
+//--- choose the generators which we want to differentiate
+   for(i=1;i<=size(LW);i++)
+   {
+      IW=0;
+      for(l=1;l<=a;l++)
+      {
+         if(LW[i][l]!=0){IW[size(IW)+1]=W[l];}
+      }
+//--- choose the variables by which to differentiate and apply diff
+      for(j=1;j<=size(LV);j++)
+      {
+          IV=0;v=0;w=0;
+          for(l=1;l<=n;l++)
+          {
+             if(LV[j][l]!=0)
+             {
+                v[size(v)+1]=l;
+                IV[size(IV)+1]=var(l);
+             }
+             else
+             {
+                w[size(w)+1]=l;
+
+             }
+          }
+          A=diff(IV,IW);      // appropriate submatrix of Jacobian
+//--- if the minor is non-zero, then it might be the one we need
+//--- ==> put it in the list of candidates
+          if(det(A)!=0)
+          {
+            v=v[2..size(v)];  // first entry is zero for technical reasons
+            w=w[2..size(w)];  // first entry is zero for technical reasons
+            L=inverse_L(A);
+            L[3]=IW;
+            L[4]=v;
+            L[5]=w;
+            re[size(re)+1]=L;
+          }
+      }
+   }
+//---------------------------------------------------------------------------
+// return the result
+//---------------------------------------------------------------------------
+   return(re);
+}
+
+/////////////////////////////////////////////////////////////////////////////
+static
+proc indexSet(int a, int b)
+"Internal procedure - no help and no example available
+"
+{
+//---------------------------------------------------------------------------
+// Find all tuples of size b containing pairwise distict elements from a
+// list of a elements
+//---------------------------------------------------------------------------
+//**************************************************************************/
+// Combinatorics is expensive in an interpreted language
+// ==> shift it into the kernel
+//**************************************************************************/
+   def R=basering;
+   list L;
+   ring S=2,x(1..a),dp;
+   ideal I=maxideal(b);
+   int i;
+   ideal J=x(1)^2;
+   for(i=2;i<=a;i++){J=J,x(i)^2;}
+   attrib(J,"isSB",1);
+   I=reduce(I,J);
+   I=simplify(I,2);
+   for(i=1;i<=size(I);i++){L[i]=leadexp(I[i]);}
+   setring R;
+   return(L);
+}
+
+/////////////////////////////////////////////////////////////////////////////
+
+proc DeltaList(list BO)
+"USAGE:  DeltaList (BO);
+@*       BO = basic object, a list: ideal W,
+@*                                  ideal J,
+@*                                  intvec b,
+@*                                  list Ex,
+@*                                  ideal ab,
+@*                                  intvec v,
+@*                                  intvec w,
+@*                                  matrix M
+ASSUME:  R  = basering, a polynomial ring, W an ideal of R,
+@*       J  = ideal containing W
+COMPUTE: Delta-operator iteratively applied to J in the notation of
+         [Bravo,Encinas,Villamayor]
+RETURN:  list l of length ((max w-ord) * b),
+         l[i+1]=Delta^i(J)
+EXAMPLE: example DeltaList;  shows an example
+"
+{
+//----------------------------------------------------------------------------
+// Iteratively apply proc Delta
+//----------------------------------------------------------------------------
+   int i;
+   list L;
+   ideal C=BO[2];
+   while(deg(C[1])!=0)
+   {
+      L[size(L)+1]=C;
+      C=Delta(BO);
+      BO[2]=C;
+   }
+   return(L);
+}
+example
+{
+   "EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y,z),dp;
+
+   ideal W=z^2-x;
+   ideal J=x*y^2+x^3;
+   intvec b=1;
+   list E;
+   ideal abb=maxideal(1);
+   intvec v;
+   intvec w=-1;
+   matrix M;
+
+   list BO=W,J,b,E,abb,v,w,M;
+
+   DeltaList(BO);
+}
+/////////////////////////////////////////////////////////////////////////////
+proc CenterBM(list BM)
+"USAGE:  CenterBM(BM);
+@*       BM = object related to a presentation,
+                            a list: ideal W,
+@*                                  ideal J,
+@*                                  intvec b,
+@*                                  list Ex,
+@*                                  ideal ab,
+@*                                  intvec v,
+@*                                  intvec w,
+@*                                  matrix M
+ASSUME:  R  = basering, a polynomial ring, W an ideal of R,
+@*       J  = ideal containing W
+COMPUTE: the center of the next blow-up of BM in the resolution algorithm
+         of [Bierstone, Milman]
+RETURN:  list l,
+         l[1]: ideal describing the center
+         l[2]: intvec w obtained in the process of determining l[1]
+         l[3]: intvec b obtained in the process of determining l[1]
+         l[4]: intmat invmat obtained in the process of determining l[1]
+EXAMPLE: example CenterBM;  shows an example
+"
+{
+//!!! NOCH NICHT IN BETRIEB
+ERROR("Not implemented yet");
+   int i,j;
+   intmat tmat[2][1]=0,-1;
+//--- re=center,E^- indices, b vector, n vector
+   list re=ideal(1),BM[7],BM[3],tmat;
+   ideal J=BM[2];
+   if(size(J)==0)
+   {
+     re[1]=ideal(0);
+     return(re);
+   }
+//--- find Delta^(b-1)(J)
+   if(size(reduce(J,std(BM[1])))!=0)
+   {
+     list L=DeltaList(BM);
+   }
+   else
+   {
+     list L;
+     L[1]=J;
+   }
+   if(!defined(debugCenter))
+   {
+     int debugCenter;
+   }
+   if(debugCenter)
+   {
+     "----> In Center: after DeltaList";
+     "W";
+     BM[1];
+     "J";
+     BM[2];
+     "The Delta List:";
+     L;
+   }
+   int b=size(L);
+   if(b==0)
+   {
+//--- if J=W, we do not need to do anything
+//--- returning center=1 marks this chart as completed
+     return(re);
+   }
+//---------------------------------------------------------------------------
+// check whether max ord is constant
+//---------------------------------------------------------------------------
+   if((BM[9][2,1]<0)||(BM[9][1,1]>b))
+   {
+//--- we are either at the beginning or the invariant has dropped
+     intvec tempvec=size(BM[4]);
+     BM[7]=tempvec;
+//!!!! nur fuer hyperflaechen!!!!!!!!
+     tempvec=b;
+     BM[3]=tempvec;
+//!!!! Ende !!!!!!!!!!!!
+     kill tempvec;
+     BM[9][1,1]=b;
+     BM[9][2,1]=1;
+   }
+//---------------------------------------------------------------------------
+// prepare for intersection with E_i
+//---------------------------------------------------------------------------
+   ideal C=L[b];
+   re[2]=BM[7];
+   re[3]=BM[3];
+   BM[2]=C;
+      if(debugCenter)
+   {
+     "----> In Center: before intersection with E_i:";
+     "bmax:",b;
+     "Sing(J,bmax):";
+      C;
+     "E:";
+      BO[4];
+     "list marking a priori known intersection properties:",BO[6];
+     "index of last element of E^- in E:",BO[7][1];
+   }
+   list E=inters_E(BM);
+// !!!!!!!!! Drop Redundant fehlt noch!!!!!!!!
+//---------------------------------------------------------------------------
+// Check whether it is a single point
+//---------------------------------------------------------------------------
+   ideal C1=std(ideal(L[b])+E[1]);
+   if(dim(C1)==0)
+   {
+     if(size(E[4])==1)
+     {
+        tmat[1,1]=BM[9][1,1];
+        tmat[2,1]=BM[9][2,1];
+        re[4]=tmat;
+        re[1]=radical(C1);
+        return(re);
+     }
+   }
+   if(size(BM[9])>2)
+   {
+      BM[9][1,2]=E[2];
+      BM[9][2,2]=1;
+   }
+   else
+   {
+      intmat tempInt[2][1]=E[2],1;
+      BM[9]=concatInt(BM[9],tempInt);
+      kill tempInt;
+   }
+   BM[2]=J;
+   list BM1=dropDim(BM);
+   list BMlist,hilfList;
+   ideal hilf;
+   intvec tempvec;
+
+   if(!attrib(BM1[1],"isSB")){BM1[1]=std(BM1[1]);}
+   for(i=1;i<=size(BM1[4]);i++)
+   {
+      hilf=simplify(reduce(BM1[4][i],BM1[1]),2);
+      if(size(hilf)>1){"Problem with BM1[4]in CenterBM";~;}
+      hilfList[i]=hilf[1];
+   }
+   for(i=1;i<=size(E[4]);i++)
+   {
+      BMlist[i]=BM1;
+      for(j=size(E[5][i]);j>=1;j--)
+      {
+         if(E[5][i][j]!=0)
+         {
+            BMlist[i][2][size(BMlist[i][2])+1]=hilfList[j];
+            BMlist[i][3][size(BMlist[i][3])+1]=1;
+         }
+         BMlist[i][4]=delete(BMlist[i][4],j);
+         BMlist[i][6]=deleteInt(BMlist[i][6],j,0);
+      }
+      BMlist[i][7]=deleteInt(BMlist[i][7],1,-1);
+      if(size(BMlist[i][9])>4)
+      {
+         intmat tempInt[2][ncols(BMlist[i][9])]=BMlist[i][9];
+         intmat tempInt2[2][ncols(BMlist[i][9])-2]=
+                 tempInt[1..2,3..ncols(BMlist[i][9])];
+         BMlist[i][9]=tempInt2;
+         kill tempInt,tempInt2;
+      }
+      else
+      {
+         BMlist[i][9]=tmat;
+      }
+   }
+   kill hilfList;list hilfList;
+   hilfList[1]=CenterTail(BMlist[1],C);
+   intmat maxmat=hilfList[1][9];
+   intvec maxiv=E[4][1];
+   int pos=1;
+   for(i=2;i<=size(E[4]);i++)
+   {
+      hilfList[i]=CenterTail(BMlist[i],C);
+      if(invGreater(hilfList[i][4]),maxmat,E[4][i],maxiv)
+      {
+         maxmat=hilfList[i][4];
+         maxiv=E[4][i];
+         pos=i;
+      }
+   }
+   re[1]=hilfList[pos][1];
+   intmat tempint=BM[9];
+   intmat tempint1[2][2]=tempint[1..2,1..2];
+   re[4]=concatInt(tempint1,maxmat);
+   re[2]=re[2][1],hilfList[pos][2];
+   re[3]=b;
+~;
+   return(re);
+}
+example
+{  "EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y),dp;
+
+   ideal W;
+   ideal J=x2-y3;
+   intvec b=1;
+   list E;
+   ideal abb=maxideal(1);
+   intvec v;
+   intvec w=-1;
+   matrix M;
+   intmat invmat[2][1]=0,-1;
+
+   list BM=W,J,b,E,abb,v,w,M,invmat;
+
+   CenterBM(BM);
+}
+
+/////////////////////////////////////////////////////////////////////////////
+static
+proc invGreater(intmat M1, intmat M2, intvec iv1, intvec iv2)
+{
+// Auxilliary procedure, BM-algorithm
+   int i;
+   for(i=1;i<=min(ncols(M1),ncols(M2));i++)
+   {
+      if(M1[2,i]==-1)
+      {
+         if(M1[1,i]==0){ERROR("Invariant not set");}
+         if(M2[2,i]!=-1){return(1);}
+         if(M2[1,i]==0){ERROR("Invariant not set");}
+         break;
+      }
+      else
+      {
+         if(M2[2,i]==-1)
+         {
+            if(M2[1,i]==0){ERROR("Invariant not set");}
+            return(0);
+         }
+         if(M1[1,i]*M2[2,i]!= M2[1,i]*M1[2,i])
+         {
+            return(M1[1,i]*M2[2,i]> M2[1,i]*M1[2,i]);
+         }
+      }
+   }
+   return(iv1>iv2);
+}
+/////////////////////////////////////////////////////////////////////////////
+proc CenterTail(list BM, ideal C)
+{
+//!!! Auxilliary procedure, BM-algorithm
+//!!!!!!!!Rueckgabe im Zentrumsformat
+  int i,j,bmin;
+  int alpha=lcm(BM[3]);
+  vector w;
+  list re;
+  if(size(BM[2])==0)
+  {
+    re[1]=C+BM[1];
+    intvec tvec;
+    re[3]=tvec;
+    intmat tmat[2][1]=-1,-1;
+    re[4]=tmat;
+    tvec=size(BM[4]);
+    re[2]=tvec;
+    return(re);
+  }
+  for(i=1;i<=size(BM[3]);i++)
+  {
+     if(BM[2][i]!=0)
+     {
+       w[size(w)+1]=BM[2][i]^(alpha/BM[3][i]);
+     }
+  }
+  module M=w;
+  intvec satex;
+  list satList;
+  for(i=1;i<=size(BM[4]);i++)
+  {
+     satList=sat(M,BM[4][i]);
+     satex[i]=satList[2];
+     M=satList[1];
+  }
+//!!!!Hilfsobjekt G bilden!!!!!!!!!!!!!!!!
+//!!!!Hilfsobjekt H,codim -1 bilden!!!!!!!!!!!!!!!!
+//!!!! ???? an welcher stelle?????????
+  list deltaL;
+  list BMtemp=BM;
+  for(i=1;i<=nrows(M[1]);i++)
+  {
+     BMtemp[2]=ideal(M[1][i])+BMtemp[1];
+     deltaL[i]=DeltaList(BMtemp);
+     if(i==1)
+     {
+        bmin=size(deltaL[i]);
+     }
+     else
+     {
+        bmin=min(size(deltaL[i]),bmin);
+     }
+  }
+  if(bmin==0)
+  {
+     re[1]=C+BM[1];
+     intvec tvec;
+     re[3]=tvec;
+     if((BM[9][2,1]==-1)||(BM[9][1,1]!=0))
+     {
+        tvec=size(BM[4]);
+        re[2]=tvec;
+        intmat tmat[2][1]=0,1;
+        re[4]=tmat;
+     }
+     else
+     {
+        re[2]=BM[7];
+        re[4]=BM[9];
+     }
+     return(re);
+  }
+  ideal Ctemp=ideal(1);
+  while(deg(Ctemp[1])==0)
+  {
+    Ctemp=C;
+    for(i=1;i<=nrows(M[1]);i++)
+    {
+       Ctemp=Ctemp,deltaL[i][bmin];
+    }
+    Ctemp=std(Ctemp);
+    bmin--;
+    if(bmin==0){ERROR("empty set");}
+  }
+  //!!!!!!!!!!!!!Invariante ist bmin/alpha
+  // naechster Eintrag s_i wie in CenterBM
+  // dann dropDim  ....
+}
+
+/////////////////////////////////////////////////////////////////////////////
+static
+proc deleteInt(intvec v,int i,int ini)
+{
+//!!! Should be in kernel of Singular
+//--- delete i-th entry in intvec v,
+//--- if necessary reinitializing v with value ini
+   int s=size(v);
+   intvec w;
+   if((i<s)&&(i>1)){w=v[1..i-1],v[i+1..s];}
+   if(s==1){w=ini;return(w);}
+   if(i==1){w=v[2..s];}
+   if(i==s){w=v[1..s-1];}
+   return(w);
+}
+/////////////////////////////////////////////////////////////////////////////
+static
+proc concatInt(intmat A, intmat B)
+{
+//!!! Should be in kernel of Singular
+//--- concatenate two intmats
+  if(nrows(A)!=nrows(B)){ERROR("could not concat, wrong number of rows");}
+  intmat tempmat[nrows(A)][ncols(A)+ncols(B)];
+  tempmat[1..nrows(A),1..ncols(A)]=A[1..nrows(A),1..ncols(A)];
+  tempmat[1..nrows(A),ncols(A)+1..ncols(tempmat)]=B[1..nrows(A),1..ncols(B)];
+  return(tempmat);
+}
+/////////////////////////////////////////////////////////////////////////////
+proc dropDim(list BM)
+{
+ERROR("Not implemented yet");
+}
+/////////////////////////////////////////////////////////////////////////////
+proc CenterBO(list BO,list #)
+"USAGE:  CenterBO(BO);
+@*       BO = basic object, a list: ideal W,
+@*                                  ideal J,
+@*                                  intvec b,
+@*                                  list Ex,
+@*                                  ideal ab,
+@*                                  intvec v,
+@*                                  intvec w,
+@*                                  matrix M
+ASSUME:  R  = basering, a polynomial ring, W an ideal of R,
+@*       J  = ideal containing W
+COMPUTE: the center of the next blow-up of BO in the resolution algorithm
+         of [Bravo,Encinas,Villamayor]
+RETURN:  list l,
+         l[1]: ideal describing the center
+         l[2]: intvec w obtained in the process of determining l[1]
+         l[3]: intvec b obtained in the process of determining l[1]
+         l[4]: intvec inv obtained in the process of determining l[1]
+EXAMPLE: example CenterBO;  shows an example
+"
+{
+//---------------------------------------------------------------------------
+// Initialization  and sanity checks
+//---------------------------------------------------------------------------
+   int i,bo7save;
+   intvec tvec;
+//--- re=center,E^- indices, b vector, n vector
+   list re=ideal(1),BO[7],BO[3],tvec;
+   ideal J=BO[2];
+   if(size(J)==0)
+   {
+     re[1]=ideal(0);
+     return(re);
+   }
+//--- find Delta^(b-1)(J)
+   if(size(reduce(J,std(BO[1])))!=0)
+   {
+     list L=DeltaList(BO);
+   }
+   else
+   {
+     list L;
+     L[1]=J;
+   }
+   if(!defined(debugCenter))
+   {
+     int debugCenter;
+   }
+   if(debugCenter)
+   {
+     "----> In Center: after DeltaList";
+     "W";
+     BO[1];
+     "J";
+     BO[2];
+     "The Delta List:";
+     L;
+   }
+   int b=size(L);
+   if(b==0)
+   {
+//--- if J=W, we do not need to do anything
+//--- returning center=1 marks this chart as completed
+     return(re);
+   }
+//---------------------------------------------------------------------------
+// check whether max w-ord is constant
+//---------------------------------------------------------------------------
+   if(b==BO[3][1])
+   {
+//--- max w-ord is constant
+     if(BO[7][1]==-1)
+     {
+//--- first got its value in the previous step ==> initialize BO[7]
+       tvec[1]=size(BO[4])-1;
+       for(i=2;i<=size(BO[7]);i++)
+       {
+         tvec[i]=BO[7][i];
+       }
+       re[2]=tvec;
+       BO[7]=tvec;
+     }
+   }
+   else
+   {
+//--- max w-ord changed ==> reset BO[7], correct BO[3]
+     tvec[1]=-1;
+     re[2]=tvec;
+     BO[7]=tvec;
+     tvec[1]=b;
+     BO[3]=tvec;
+     if(defined(invSat))
+     {
+        invSat[2]=intvec(0);
+     }
+   }
+   re[3]=BO[3];
+//---------------------------------------------------------------------------
+// reduce from case 2 to case 1 of [Bravo, Encinas, Villamayor]
+//---------------------------------------------------------------------------
+   ideal C=L[b];
+   BO[2]=C;
+   if(debugCenter)
+   {
+     "----> In Center: before intersection with E_i:";
+     "bmax:",b;
+     "Sing(J,bmax):";
+      C;
+     "E:";
+      BO[4];
+     "list marking a priori known intersection properties:",BO[6];
+     "index of last element of E^- in E:",BO[7][1];
+   }
+//--- is intermediate result in iteration already good?
+//--- return it to calling proc CenterBO
+   if(size(#)>0)
+   {
+     if(#[1]==2)
+     {
+       re[1]=C;
+       kill tvec;
+       intvec tvec=re[2][1];
+       re[2]=tvec;
+       kill tvec;
+       intvec tvec=re[3][1];
+       re[3]=tvec;
+       kill tvec;
+       intvec tvec;
+       re[4]=tvec;
+       return(re);
+     }
+   }
+//--- do the reduction to case 1
+   list E=inters_E(BO);
+//--- if J is smooth and not too many E_i intersect simultaneously, let us
+//--- try to drop redundant components of the candidate for the center
+   if((b==1)&&(size(E)>3))
+   {
+//--- if J is not smooth we do not want to drop any information
+     if((size(E[4])>0) && (dim(std(slocusE(BO[2])))<0))
+     {
+//--- BO[2]==J because b==1
+//--- DropRedundant is the counterpart to DropCoeff
+//--- do not leave out one of them separately!!!
+      E=DropRedundant(BO,E);
+      if(size(E)==1)
+       {
+         kill tvec;
+         intvec tvec=re[2][1];
+         re[2]=tvec;
+         tvec[1]=re[3][1];
+         re[3]=tvec;
+         tvec[1]=re[4][1];
+         re[4]=tvec;
+         re[1]=E[1];
+         return(re);
+       }
+     }
+   }
+//--- set n correctly
+   if(E[2]<BO[9][1])
+   {
+//--- if n dropped, the subsequent Coeff-object will not be the same
+//--- ===> set BO[3][2] to zero to make sure that no previous data is used
+      if(defined(tvec)) {kill tvec;}
+      intvec tvec=BO[7][1],-1;
+      BO[7]=tvec;
+      tvec=BO[3][1],0;
+      BO[3]=tvec;
+      if(defined(invSat))
+      {
+         invSat[2]=intvec(0);
+      }
+   }
+   re[4][1]=E[2];
+   C=E[1]^b+J;
+   C=mstd(C)[2];
+   ideal C1=std(ideal(L[b])+E[1]);
+   if(debugCenter)
+   {
+     "----> In Center: reduction of case 2 to case 1";
+     "Output of inters_E, after dropping redundant components:";
+      E;
+     "result of intersection with E^-, i.e.(E^-)^b+J:";
+     C;
+     "candidate for center:";
+     C1;
+   }
+//---------------------------------------------------------------------------
+// Check whether we have a hypersurface component
+//---------------------------------------------------------------------------
+   if(dim(C1)==dim(std(BO[1]))-1)
+   {
+     if((size(reduce(J,C1))==0)&&(size(reduce(C1,std(J)))==0))
+     {
+//--- C1 equals J and is of codimension 1 in W
+        re[1]=C1;
+     }
+     else
+     {
+//--- C1 has a codimension 1 (in W) component
+        re[1]=std(equiRadical(C1));
+     }
+     kill tvec;
+     intvec tvec=re[2][1];
+     re[2]=tvec;
+     tvec[1]=re[3][1];
+     re[3]=tvec;
+     tvec[1]=re[4][1];
+     re[4]=tvec;
+//--- is the codimension 1 component a good choice or do we need to reset
+//--- the information from the previous steps
+     if(transversalT(re[1],BO[4]))
+     {
+        if(size(E)>2)
+        {
+          if(E[3]>E[2])
+          {
+            if(defined(shortcut)){kill shortcut;}
+            list shortcut=ideal(0),size(BO[4]),BO[7];
+            export(shortcut);
+          }
+        }
+        return(re);
+     }
+
+     ERROR("reset in Center, please send the example to the authors.");
+   }
+//---------------------------------------------------------------------------
+// Check whether it is a single point
+//---------------------------------------------------------------------------
+   if(dim(C1)==0)
+   {
+      C1=std(radical(C1));
+      if(vdim(C1)==1)
+      {
+//--- C1 is one point
+        re[1]=C1;
+        kill tvec;
+        intvec tvec=re[2][1];
+        re[2]=tvec;
+        kill tvec;
+        intvec tvec=re[3][1];
+        re[3]=tvec;
+        return(re);
+      }
+    }
+//---------------------------------------------------------------------------
+// Prepare input for forming the Coeff-Ideal
+//---------------------------------------------------------------------------
+   BO[2]=C;
+   if(size(BO[2])>5)
+   {
+      BO[2]=mstd(BO[2])[2];
+   }
+//--- drop leading entry of BO[3]
+   tvec=BO[3];
+   if(size(tvec)>1)
+   {
+     tvec=tvec[2..size(tvec)];
+     BO[3]=tvec;
+   }
+   else
+   {
+     BO[3][1]=0;
+   }
+   tvec=BO[9];
+   if(size(tvec)>1)
+   {
+     tvec=tvec[2..size(tvec)];
+     BO[9]=tvec;
+   }
+   else
+   {
+     BO[9][1]=0;
+   }
+   bo7save=BO[7][1];          // original value needed for result
+   if(defined(shortcut))
+   {
+     if((bo7save!=shortcut[3][1])&&(size(shortcut[3])!=1))
+     {
+       kill shortcut;
+     }
+     else
+     {
+       shortcut[2]=shortcut[2]-bo7save;
+       tvec=shortcut[3];
+       if(size(tvec)>1)
+       {
+         tvec=tvec[2..size(tvec)];
+         shortcut[3]=tvec;
+       }
+       else
+       {
+         shortcut[3]=intvec(shortcut[2]);
+       }
+     }
+   }
+   if(BO[7][1]>-1)
+   {
+//--- drop E^- and the corresponding information from BO[6]
+     for(i=1;i<=BO[7][1];i++)
+     {
+       BO[4]=delete(BO[4],1);
+       intvec bla1=BO[6];
+       BO[6]=intvec(bla1[2..size(bla1)]);
+       kill bla1;
+     }
+//--- drop leading entry of BO[7]
+     tvec=BO[7];
+     if(size(tvec)>1)
+     {
+       tvec=tvec[2..size(tvec)];
+       BO[7]=tvec;
+     }
+     else
+     {
+       BO[7][1]=-1;
+     }
+   }
+   else
+   {
+     if(BO[7][1]==-1)
+     {
+       list tplist;
+       BO[4]=tplist;
+       kill tplist;
+     }
+   }
+   if(debugCenter)
+   {
+     "----> In Center: Input to Coeff";
+     "b:",b;
+     "BO:";
+     BO;
+   }
+//--- prepare the third entry of the invariant tuple
+   int invSatSave=invSat[2][1];
+   tvec=invSat[2];
+   if(size(tvec)>1)
+   {
+     tvec=tvec[2..size(tvec)];
+     invSat[2]=tvec;
+   }
+   else
+   {
+     invSat[2][1]=0;
+   }
+//---------------------------------------------------------------------------
+// Form the Coeff-ideal, if possible and useful; otherwise use the previous
+// candidate for the center
+//---------------------------------------------------------------------------
+   list BO1=Coeff(BO,b);
+   if(debugCenter)
+   {
+     "----> In Center: Output of Coeff";
+     BO1;
+   }
+//--- Coeff returns int if something went wrong
+   if(typeof(BO1[1])=="int")
+   {
+      if(BO1[1]==0)
+      {
+//--- Coeff ideal was already resolved
+        re[1]=C1;
+        return(re);
+      }
+      else
+      {
+//--- no global hypersurface found
+        re=CoverCenter(BO,b,BO1[2]);
+        kill tvec;
+        intvec tvec=invSatSave;
+        for(i=1;i<=size(invSat[2]);i++)
+        {
+           tvec[i+1]=invSat[2][i];
+        }
+        invSat[2]=tvec;
+        return(re);
+      }
+   }
+   int coeff_invar;
+   ideal Idropped=1;
+//--- if b=1 drop redundant components of the Coeff-ideal
+   if(b==1)
+   {
+//--- Counterpart to DropRedundant -- do not leave out one of them separately
+     Idropped=DropCoeff(BO1);         // blow-up in these components
+                                      // is unnecessary
+   }
+//--- to switch off DropCoeff, set Idropped=1;
+   BO1[2]=sat(BO1[2],Idropped)[1];
+   if(deg(BO1[2][1])==0)
+   {
+//--- Coeff ideal is trivial
+     C1=radical(C1);
+     ideal C2=sat(C1,Idropped)[1];
+     if(deg(std(C2)[1])!=0)
+     {
+        C1=C2;
+     }
+//Aenderung: Strategie: nur im Notfall ganze except. Divisoren
+     if(deg(std(BO1[2])[1])==0)
+     {
+       list BOtemp=BO;
+       int bo17save=BO1[7][1];
+       BOtemp[7]=0;
+       BO1=Coeff(BOtemp,b,int(0));
+       BO1[2]=sat(BO1[2],Idropped)[1];
+       if(deg(std(BO1[2])[1])==0)
+       {
+//--- there is really nothing left to do for the Coeff ideal
+//--- the whole original BO1[2], i.e. Idropped, is the upcoming center
+          re[1]=Idropped;
+          re[2]=intvec(bo7save);
+          re[3]=intvec(b);
+          re[4]=intvec(E[2]);
+          return(re);
+       }
+       if(deg(std(slocus(radical(BO1[2])))[1])==0)
+       {
+          re[1]=BO1[2];
+//          re[2]=intvec(bo7save,BO1[7][1]);
+          re[2]=intvec(bo7save,bo17save);
+          re[3]=intvec(b,1);
+          re[4]=intvec(E[2],1);
+          invSat[2]=intvec(1,0);
+          return(re);
+       }
+//!!! effizienter machen???
+       list pr=primdecGTZ(BO1[2]);
+       ideal Itemp1=1;
+       int aa,bb;
+       for(aa=1;aa<=size(pr);aa++)
+       {
+          if(dim(std(pr[aa][2])) < (dim(std(BO1[1]))-1))
+          {
+//--- drop components which are themselves exceptional diviosrs
+             Itemp1=intersect(Itemp1,pr[aa][1]);
+          }
+       }
+       if(deg(std(Itemp1)[1])!=0)
+       {
+//--- treat the remaining components of the weak Coeff ideal
+          BO1[2]=Itemp1;
+       }
+       BO1[7]=BO[7];
+       for(aa=1;aa<=size(BO1[4]);aa++)
+       {
+         if(deg(std(BO1[4][aa])[1])==0){aa++;continue;}
+         if(defined(satlist)){kill satlist;}
+         list satlist=sat(BO1[2],BO1[4][aa]+BO1[1]);
+         if(deg(std(satlist[1])[1])==0)
+         {
+            coeff_invar++;
+            if(satlist[2]!=0)
+            {
+              for(bb=1;bb<=satlist[2]-1;bb++)
+              {
+                 BO1[2]=quotient(BO1[2],BO1[4][aa]+BO1[1]);
+              }
+            }
+            else
+            {
+              ERROR("J of temporary object had unexpected value;
+                     please send this example to the authors.");
+            }
+         }
+         else
+         {
+            BO1[2]=satlist[1];
+         }
+       }
+       if(deg(std(Itemp1)[1])==0)
+       {
+          re[1]=BO1[2];
+          re[2]=intvec(bo7save,BO1[7][1]);
+          re[3]=intvec(b,1);
+          re[4]=intvec(E[2],1);
+          invSat[2]=intvec(1,0);
+          return(re);
+       }
+       kill aa,bb;
+     }
+   }
+   if(invSatSave<coeff_invar)
+   {
+     invSatSave=coeff_invar;
+   }
+//---------------------------------------------------------------------------
+// Determine Center of Coeff-ideal and use it as the new center
+//---------------------------------------------------------------------------
+   if(!defined(templist))
+   {
+     if(size(BO1[2])>5)
+     {
+        BO1[2]=mstd(BO1[2])[2];
+     }
+     list templist=CenterBO(BO1,2);
+//--- only a sophisticated guess of a good center computed by
+//--- leaving center before intersection with the E_i.
+//--- whether the guess was good, is stored in 'good'.
+//--- (this variant saves charts in cases like the Whitney umbrella)
+     list E0,E1;
+
+     ideal Cstd=std(radical(templist[1]));
+     int good=((deg(std(slocusE(Cstd))[1])==0)&&(dim(std(BO1[2]))<=2));
+//if(defined(satlist)){good=0;}
+     if(good)
+     {
+        for(i=1;i<=size(BO[4]);i++)
+        {
+           if((deg(BO[4][i][1])>0)&&(size(reduce(BO[4][i],Cstd))!=0))
+           {
+              E0[size(E0)+1]=BO[4][i]+Cstd;
+              E1[size(E1)+1]=BO[4][i];
+           }
+        }
+        good=transversalT(Cstd,E1);
+        if(good)
+        {
+           good=normalCross(E0);
+        }
+     }
+     if(good)
+     {
+        list templist2=CenterBO(BO1,1);
+        if(dim(std(templist2[1]))!=dim(Cstd))
+        {
+           templist[1]=Cstd;
+           if(defined(shortcut)){kill shortcut;}
+           list shortcut=ideal(0),size(BO1[4]),templist[2];
+           export(shortcut);
+        }
+        else
+        {
+           templist=templist2;
+        }
+        kill templist2;
+     }
+     else
+     {
+//--- sophisticated guess was wrong, follow Villamayor's approach
+        kill templist;
+        list templist=CenterBO(BO1,1);
+     }
+   }
+   if((dim(std(templist[1]))==dim(std(BO1[1]))-1)
+       &&(size(templist[4])==1))
+   {
+     if(templist[4][1]==0)
+     {
+        for(i=1;i<=size(BO1[4]);i++)
+        {
+           if(size(reduce(templist[1],std(BO1[4][i])))==0)
+           {
+              templist[4][1]=1;
+              break;
+           }
+        }
+     }
+   }
+//!!! subsequent line should be deleted
+//if(defined(satlist)){templist[3][1]=BO[3][1];}
+   if(debugCenter)
+   {
+     "----> In Center: Iterated Center returned:";
+     templist;
+   }
+//--------------------------------------------------------------------------
+// set up the result and return it
+//--------------------------------------------------------------------------
+   re[1]=templist[1];
+   kill tvec;
+   intvec tvec;
+   tvec[1]=bo7save;
+   for(i=1;i<=size(templist[2]);i++)
+   {
+     tvec[i+1]=templist[2][i];
+   }
+   re[2]=tvec;
+   if(defined(shortcut))
+   {
+      shortcut[2]=shortcut[2]+bo7save;
+      shortcut[3]=tvec;
+   }
+   kill tvec;
+   intvec tvec;
+   tvec[1]=invSatSave;
+   for(i=1;i<=size(invSat[2]);i++)
+   {
+      tvec[i+1]=invSat[2][i];
+   }
+   invSat[2]=tvec;
+   kill tvec;
+   intvec tvec;
+   tvec[1]=b;
+   for(i=1;i<=size(templist[3]);i++)
+   {
+     tvec[i+1]=templist[3][i];
+   }
+   re[3]=tvec;
+   kill tvec;
+   intvec tvec;
+   tvec[1]=E[2];
+   for(i=1;i<=size(templist[4]);i++)
+   {
+     tvec[i+1]=templist[4][i];
+   }
+   re[4]=tvec;
+
+   return(re);
+}
+example
+{  "EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y),dp;
+
+   ideal W;
+   ideal J=x2-y3;
+   intvec b=1;
+   list E;
+   ideal abb=maxideal(1);
+   intvec v;
+   intvec w=-1;
+   matrix M;
+
+   list BO=W,J,b,E,abb,v,w,M,v;
+
+   CenterBO(BO);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc CoverCenter(list BO,int b, ideal Jb)
+{
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+   def R=basering;
+   int i,j,k;
+   intvec merk,merk2,maxv,fvec;
+   list L,ceList,re;
+   ceList[1]=ideal(0);
+   poly @p,@f;
+   ideal K,dummy;
+   if(!attrib(BO[2],"isSB"))
+   {
+     BO[2]=std(BO[2]);
+   }
+   for(i=1;i<=size(Jb);i++)
+   {
+      list tempmstd=mstd(slocus(Jb[i]));
+      if(size(tempmstd[1])>size(tempmstd[2]))
+      {
+         dummy=tempmstd[2];
+      }
+      else
+      {
+         dummy=tempmstd[1];
+      }
+      kill tempmstd;
+      L[i]=dummy;
+      K=K,dummy;
+   }
+   K=simplify(K,2);
+//---------------------------------------------------------------------------
+// The intersection of the singular loci of the L[i] is empty.
+// Find a suitable open covering of the affine chart, such that a global
+// hypersurface can be found in each open set.
+//---------------------------------------------------------------------------
+   matrix M=lift(K,ideal(1));
+   j=1;
+   for(i=1;i<=nrows(M);i++)
+   {
+      if(M[i,1]!=0)
+      {
+         merk[size(merk)+1]=i;
+         fvec[size(merk)]=j;
+      }
+      if((i-k)==size(L[j]))
+      {
+        k=i;
+        j++;
+      }
+   }
+//--------------------------------------------------------------------------
+// Find a candidate for the center in each open set
+//--------------------------------------------------------------------------
+//--- first entry of merk is 0 by construction of merk
+   for(i=2;i<=size(merk);i++)
+   {
+//--- open set is D(@p)
+       @p=K[merk[i]];
+//--- hypersurface is V(@f)
+       @f=Jb[fvec[i]];
+       execute("ring R1=("+charstr(R)+"),(@y,"+varstr(R)+"),dp;");
+       poly p=imap(R,@p);
+       poly f=imap(R,@f);
+       list @ce;
+       list BO=imap(R,BO);
+       BO[1]=BO[1]+ideal(@y*p-1);
+       BO[2]=BO[2]+ideal(@y*p-1);
+       for(j=1;j<=size(BO[4]);j++)
+       {
+          BO[4][j]=BO[4][j]+ideal(@y*p-1);
+       }
+//--- like usual Coeff, but hypersurface is already known
+       list BO1=SpecialCoeff(BO,b,f);
+//--- special situation in SpecialCoeff are marked by an error code of
+//--- type int
+       if(typeof(BO1[1])=="int")
+       {
+         if(BO1[1]==0)
+         {
+//--- Coeff ideal was already resolved
+           @ce[1]=BO[2];
+           @ce[2]=BO[7];
+           @ce[3]=BO[3];
+         }
+         else
+         {
+           if(BO[3]!=0)
+           {
+//--- intersections with E do not meet conditions ==> reset
+              ERROR("reset in Coeff, please send the example to the autors");
+           }
+         }
+       }
+       else
+       {
+//--- now do the recursion as usual
+         @ce=CenterBO(BO1);
+       }
+//---------------------------------------------------------------------------
+// Go back to the whole affine chart and form a suitable union of the
+// candidates
+//---------------------------------------------------------------------------
+//--- pass from open set to the whole affine chart by taking the closure
+       @ce[1]=eliminate(@ce[1],@y);
+       setring R;
+       ceList[i]=imap(R1,@ce);
+//--- set up invariant vector and determine maximum value of it
+       if(size(ceList[i][3])==size(ceList[i][4]))
+       {
+          kill merk2,maxv;
+          intvec merk2,maxv;
+          for(j=1;j<=size(ceList[i][3]);j++)
+          {
+            merk2[2*j-1]=ceList[i][3][j];
+            merk2[2*j]=ceList[i][4][j];
+            ceList[i][5]=merk2;
+            if(maxv<merk2)
+            {
+               maxv=merk2;
+            }
+          }
+       }
+       else
+       {
+          ERROR("This situation should not occur, please send the example
+                 to the authors.");
+       }
+       kill R1;
+   }
+   kill merk2;
+   intvec merk2=-2;
+//--- form the union of the components of the center with maximum invariant
+   for(i=1;i<=size(ceList);i++)
+   {
+     if(size(reduce(ceList[i][1],BO[2]))==0)
+     {
+//--- already resolved ==> ignore
+       i++;
+       continue;
+     }
+     if(ceList[i][5]==maxv)
+     {
+        if(merk2!=ceList[i][2])
+        {
+//--- E^- not of the same size as before resp. initialization
+          if(merk2[1]==-2)
+          {
+//--- initialization: save size of E^-
+            merk2=ceList[i][2];
+            re[1]=ceList[i][1];
+            re[2]=ceList[i][2];
+            re[3]=ceList[i][3];
+            re[4]=ceList[i][4];
+          }
+          else
+          {
+//--- otherwise ignore
+            i++;
+            continue;
+          }
+        }
+        else
+        {
+          re[1]=intersect(re[1],ceList[i][1]);
+        }
+     }
+   }
+//--------------------------------------------------------------------------
+// Perform last checks and return the result
+//--------------------------------------------------------------------------
+   if(size(re)!=4)
+   {
+//--- oops: already resolved in all open sets
+     re[1]=BO[2];
+     re[2]=-1;
+     re[3]=0;
+     re[4]=intvec(0);
+   }
+   return(re);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc SpecialCoeff(list BO,int b,poly f)
+{
+//----------------------------------------------------------------------------
+// Coeff with given hypersurface -- no checks of the hypersurface performed
+//----------------------------------------------------------------------------
+   int i,ch;
+   ch=char(basering);
+   int e=int(factorial(b,ch));
+   ideal C;
+   list L=DeltaList(BO);
+   int d=size(L);
+//--- set up ideal
+   for(i=0;i<b;i++)
+   {
+      C=C+L[i+1]^(e/(b-i));
+   }
+//--- move to hypersurface V(Z)
+   ideal Z=f;
+   C=C,Z;
+   BO[1]=BO[1]+Z;
+   BO[2]=C;
+   for(i=1;i<=size(BO[4]);i++)
+   {
+      BO[6][i]=0;             // reset intersection indicator
+      BO[4][i]=BO[4][i]+Z;    // intersect the E_i
+      BO[2]=sat(BO[2],BO[4][i]+BO[1])[1];
+                              // "strict transform" of J w.r.t E, not "total"
+   }
+   return(BO);
+}
+
+//////////////////////////////////////////////////////////////////////////////
+static
+proc DropCoeff(list BO)
+"Internal procedure - no help and no example available
+"
+{
+//--- Initialization
+  int i,j;
+  list pr=minAssGTZ(BO[2]);
+  ideal I=BO[2];
+  ideal Itemp;
+  ideal Idropped=1;
+//--- Tests
+  for(i=1;i<=size(pr);i++)
+  {
+     if(i>size(pr))
+     {
+//--- the continue statement does not test the loop condition *sigh*
+        break;
+     }
+     if(deg(std(slocus(pr[i]))[1])!=0)
+     {
+//--- this component is singular ===> we still need it
+        i++;
+        continue;
+     }
+     Itemp=sat(I,pr[i])[1];
+     if(deg(std(Itemp+pr[i])[1])!=0)
+     {
+//--- this component is not disjoint from the other ones ===> we still need it
+        i++;
+        continue;
+     }
+     if(!transversalT(pr[i],BO[4]))
+     {
+//--- this component does not meet one of the remaining E_i transversally
+//--- ===> we still need it
+        i++;
+        continue;
+     }
+     if(!normalCross(BO[4],pr[i]))
+     {
+//--- this component is not normal crossing with the remaining E_i
+//--- ===> we still need it
+        i++;
+        continue;
+     }
+     if(defined(EE)){kill EE;}
+     list EE;
+     for(j=1;j<=size(BO[4]);j++)
+     {
+        EE[j]=BO[4][j]+pr[i];
+     }
+     if(!normalCross(EE))
+     {
+//--- we do not have a normal crossing situation for this component after all
+//--- ===> we still need it
+        i++;
+        continue;
+     }
+     Idropped=intersect(Idropped,pr[i]);
+     I=Itemp;
+  }
+  return(Idropped);
+}
+
+//////////////////////////////////////////////////////////////////////////////
+static
+proc DropRedundant(list BO,list E)
+"Internal procedure - no help and no example available
+"
+{
+//---------------------------------------------------------------------------
+// Initialization and sanity checks
+//---------------------------------------------------------------------------
+  int ii,jj,kkdiff,nonnormal,ok;
+  ideal testid,dummy;
+  ideal center;
+  intvec transverse,dontdrop,zerovec;
+  transverse[size(BO[4])]=0;
+  dontdrop[size(E[4])]=0;
+  zerovec[size(E[4])]=0;
+  ideal J=BO[2];
+  int dimJ=dim(std(BO[2]));
+  list templist;
+  if(size(E)<5)
+  {
+//--- should not occur
+    return(E);
+  }
+  for(ii=1;ii<=BO[7][1];ii++)
+  {
+     if(BO[6][ii]==2)
+     {
+       kkdiff++;
+     }
+  }
+  int expDim=dimJ-E[2]+kkdiff;
+  if(size(E)==6)
+  {
+    nonnormal=E[6];
+  }
+//---------------------------------------------------------------------------
+// if dimJ were smaller than E[2], we would not have more than 3 entries in
+//    in the list E
+// if dimJ is also at least E[3] and nonnormal is 0, we only need to test that
+// * the intersection is of the expected dimension
+// * the intersections of the BO[4][i] and J are normal crossing
+// * the elements of E^+ have no influence (is done below)
+//---------------------------------------------------------------------------
+  if((E[3]<=dimJ)&&(!nonnormal))
+  {
+    ideal bla=E[1]+BO[2]+BO[1];
+    bla=radical(bla);
+    bla=mstd(bla)[2];
+
+    if(dim(std(slocusE(bla)))<0)
+    {
+      if(transversalT(J,BO[4]))
+      {
+        ok=1;
+        if(E[2]==E[3])
+        {
+//--- no further intersection with elements from E^+
+          for(ii=1;ii<=size(E[4]);ii++)
+          {
+            if(dim_slocus(BO[2]+E[4][ii])!=-1)
+            {
+              dontdrop[ii]=1;
+            }
+          }
+          if(dontdrop==zerovec)
+          {
+            list relist;
+            relist[1]=std(J);
+            return(relist);
+          }
+        }
+      }
+    }
+  }
+//---------------------------------------------------------------------------
+// now check whether the E_i actually occurring in the intersections meet
+// J transversally (one by one) and mark those elements of E[4] where it is
+// not the case
+//---------------------------------------------------------------------------
+ if(!ok)
+ {
+     for(ii=1;ii<=size(E[5]);ii++)
+     {
+//--- test the ii-th tuple of E[4] resp. its indices E[5]
+       for(jj=1;jj<=size(E[5][ii]);jj++)
+       {
+//--- if E[5][ii][jj]==1, E_jj is involved in E[4][ii]
+        if(E[5][ii][jj]==1)
+         {
+//--- transversality not yet determined
+           if(transverse[jj]==0)
+           {
+             templist[1]=BO[4][jj];
+             if(transversalT(BO[2],templist))
+             {
+               transverse[jj]=1;
+             }
+             else
+             {
+               transverse[jj]=-1;
+               dontdrop[ii]=1;
+             }
+           }
+           else
+           {
+//--- already computed transversality
+             if(transverse[jj]<0)
+             {
+               dontdrop[ii]=1;
+             }
+           }
+         }
+       }
+     }
+   }
+//---------------------------------------------------------------------------
+// if one of the non-marked tuples from E^- in E[4] has an intersection
+// of the expected dimension and does not meet any E_i from E^+
+// - except the ones which are met trivially - , it should be
+// dropped from the list.
+// it can also be dropped if an intersection occurs and normal crossing has
+// been checked.
+//---------------------------------------------------------------------------
+  for(ii=1;ii<=size(E[4]);ii++)
+  {
+//--- if E[4][ii] does not have transversal intersections, we cannot drop it
+    if(dontdrop[ii]==1)
+    {
+      ii++;
+      continue;
+    }
+//--- testing ii-th tuple from E[4]
+    testid=BO[1]+BO[2]+E[4][ii];
+    if(dim(std(testid))!=expDim)
+    {
+//--- not expected dimension
+      dontdrop[ii]=1;
+      ii++;
+      continue;
+    }
+    testid=mstd(testid)[2];
+
+    if(dim(std(slocusE(testid)))>=0)
+    {
+//--- not smooth, i.e. more than one component which intersect
+      dontdrop[ii]=1;
+      ii++;
+      continue;
+    }
+//--- if E^+ is empty, we are done; otherwise check intersections with E^+
+    if(BO[7][1]!=-1)
+    {
+      if(defined(pluslist)){kill pluslist;}
+      list pluslist;
+      for(jj=BO[7][1]+1;jj<=size(BO[4]);jj++)
+      {
+        dummy=BO[4][jj]+testid;
+        dummy=std(dummy);
+        if(expDim==dim(dummy))
+        {
+//--- intersection has wrong dimension
+          dontdrop[ii]=1;
+          break;
+        }
+        pluslist[jj-BO[7][1]]=BO[4][jj]+testid;
+      }
+      if(dontdrop[ii]==1)
+      {
+        ii++;
+        continue;
+      }
+      if(!normalCross(pluslist))
+      {
+//--- unfortunately, it is not normal crossing
+        dontdrop[ii]=1;
+      }
+    }
+  }
+//---------------------------------------------------------------------------
+// The returned list should look like the truncated output of inters_E
+//---------------------------------------------------------------------------
+  list retlist;
+  for(ii=1;ii<=size(E[4]);ii++)
+  {
+    if(dontdrop[ii]==1)
+    {
+      if(size(center)>0)
+      {
+        center=intersect(center,E[4][ii]);
+      }
+      else
+      {
+        center=E[4][ii];
+      }
+    }
+  }
+  retlist[1]=center;
+  retlist[2]=E[2];
+  retlist[3]=E[3];
+  return(retlist);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc transversalT(ideal J, list E,list #)
+"Internal procedure - no help and no example available
+"
+{
+//----------------------------------------------------------------------------
+// check whether J and each element of the list E meet transversally
+//----------------------------------------------------------------------------
+   def R=basering;
+   if(size(#)>0)
+   {
+     ideal pp=#[1];
+   }
+   int i;
+   ideal T,M;
+   ideal Jstd=std(J);
+   ideal Tstd;
+   int d=nvars(basering)-dim(Jstd)+1;   // d=n-dim(V(J) \cap hypersurface)
+   for(i=1;i<=size(E);i++)
+   {
+      if(size(reduce(E[i],Jstd))==0)
+      {
+//--- V(J) is contained in E[i]
+        return(0);
+      }
+      T=J,E[i];
+      Tstd=std(T);
+      d=nvars(basering)-dim(Tstd);
+      if(deg(Tstd[1])!=0)
+      {
+//--- intersection is non-empty
+//!!! abgeklemmt, da es doch in der Praxis vorkommt und korrekt sein kann!!!
+//!!! wenn ueberhaupt dann -1 zurueckgeben!!!
+//         if((d>=4)&&(size(T)>=10)){return(0);}
+         M=minor(jacob(T),d,Tstd)+T;
+         M=std(M);
+         if(deg(M[1])>0)
+         {
+//--- intersection is not transversal
+           if(size(#)==0)
+           {
+              return(0);
+           }
+           M=std(radical(M));
+           if(size(reduce(pp,M))>0){return(0);}
+         }
+      }
+   }
+//--- passed all tests
+   return(1);
+}
+///////////////////////////////////////////////////////////////////////////////
+static
+proc transversalTB(ideal J, list E,ideal V)
+"Internal procedure - no help and no example available
+"
+{
+//----------------------------------------------------------------------------
+// check whether J and each element of the list E meet transversally
+//----------------------------------------------------------------------------
+   def R=basering;
+
+   int i;
+   ideal T,M;
+   ideal Jstd=std(J);
+   ideal Tstd;
+   int d=nvars(basering)-dim(Jstd)+1;   // d=n-dim(V(J) \cap hypersurface)
+   for(i=1;i<=size(E);i++)
+   {
+      if(size(reduce(E[i],Jstd))==0)
+      {
+//--- V(J) is contained in E[i]
+        return(0);
+      }
+      T=J,E[i];
+      Tstd=std(T);
+      d=nvars(basering)-dim(Tstd);
+      if(deg(Tstd[1])!=0)
+      {
+//--- intersection is non-empty
+         if((d>=4)&&(size(T)>=10)){return(0);}
+         M=minor(jacob(T),d,Tstd)+T;
+         M=std(M+V);
+         if(deg(M[1])>0)
+         {
+            return(0);
+         }
+      }
+   }
+//--- passed all tests
+   return(1);
+}
+///////////////////////////////////////////////////////////////////////////////
+static
+proc powerI(ideal I,int n,int m)
+{
+//--- compute (n!/m)-th power of I, more efficient variant
+   int i;
+   int mon=1;
+   int ch=char(basering);
+   for(i=1;i<=size(I);i++)
+   {
+     if(size(I[i])>1){mon=0;break;}
+   }
+   if(mon)
+   {
+      if(size(reduce(I,std(radical(I[1]))))<size(I)-1){mon=0;}
+   }
+   if((mon)&&(size(I)>3))
+   {
+      int e=int(factorial(n,ch))/m;
+      ideal J=1;
+      poly p=I[1];
+      I=I[2..size(I)];
+      ideal K=p^e;
+      for(i=1;i<=e;i++)
+      {
+         J=interred(J*I);
+         K=K,(p^(e-i))*J;
+      }
+      return(K);
+   }
+   for(i=n;i>1;i--)
+   {
+      if(i!=m)
+      {
+         I=I^i;
+      }
+   }
+   return(I);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+static
+proc Coeff(list BO, int b, list #)
+"USAGE:  Coeff (BO);
+@*       BO = basic object, a list: ideal W,
+@*                                  ideal J,
+@*                                  intvec b (already truncated for Coeff),
+@*                                  list Ex  (already truncated for Coeff),
+@*                                  ideal ab,
+@*                                  intvec v,
+@*                                  intvec w (already truncated for Coeff),
+@*                                  matrix M
+@*       b  = integer indication bmax(BO)
+ASSUME:  R  = basering, a polynomial ring, W an ideal of R,
+@*       J  = ideal containing W
+COMPUTE: Coeff-Ideal of BO as defined in [Bravo,Encinas,Villamayor]
+RETURN:  basic object of the Coeff-Ideal
+EXAMPLE: example Coeff;    shows an example
+"
+{
+//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+//!!! TASK: lower dimension by more than one in a single step if possible !!!
+//!!!       (improve bookkeeping of invariants in Coeff and Center)       !!!
+//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+//---------------------------------------------------------------------------
+// Initialization  and sanity checks
+//---------------------------------------------------------------------------
+   int ch=char(basering);
+   int i,k,dummy,errtype;
+   int ma=size(BO[4]);
+   intvec merk;
+   if(!defined(debugCoeff))
+   {
+     int debugCoeff;
+   }
+   ideal C;
+   list L;
+   if(size(#)!=0)
+   {
+      if(typeof(#[1])=="ideal")
+      {
+        L=#;
+      }
+      else
+      {
+        ma=#[1];
+        L=DeltaList(BO);
+      }
+   }
+   else
+   {
+      L=DeltaList(BO);
+   }
+
+   if(debugCoeff)
+   {
+     "----> In Coeff: result of DeltaList:";
+     L;
+   }
+   int d=size(L);                   // bmax of BO
+   if((debugCoeff)&&(d!=b))
+   {
+      "!!!!!! Length of DeltaList does not equal second argument !!!!!!";
+      "!!!!!! BO might not have been ord ~ 1 or wrong b          !!!!!!";
+   }
+   if(b>=6){return(0);}              // b is too big
+   int e=int(factorial(b,ch));       // b of Coeff-Ideal
+   if(e==0)
+   {
+     ERROR( "// characteristic too small for forming b! .");
+   }
+   if(b==0)
+   {
+     ERROR( "// second argument to Coeff should never be zero."  );
+   }
+//----------------------------------------------------------------------------
+// Form the Coeff-Ideal
+// Step 1: choose hypersurface
+// Step 2: sum over correct powers of Delta^i(BO[2])
+// Step 3: do the intersection
+//----------------------------------------------------------------------------
+//--- Step 1
+   ideal Z;
+   poly p;
+   for(i=1;i<=ncols(L[d]);i++)
+   {
+//--- Look for smooth hypersurface in generators of Delta^(bmax-1)(BO[2])
+     dummy=goodChoice(BO,L[d][i]);
+     if(!dummy)
+     {
+       Z= L[d][i];
+       break;
+     }
+     else
+     {
+       if(dummy>1)
+       {
+          merk[size(merk)+1]=i;
+       }
+       if(dummy>errtype)
+       {
+         errtype=dummy;
+       }
+     }
+   }
+   if(size(Z)==0)
+   {
+//--- no suitable element in generators of Delta^(bmax-1)(BO[2])
+//--- try random linear combination
+      for(k=1;k<=10;k++)
+      {
+         for(i=2;i<=size(merk);i++)
+         {
+            p=p+random(-100,100)*L[d][merk[i]];
+         }
+         dummy=goodChoice(BO,p);
+         if(!dummy)
+         {
+            Z=p;
+            break;
+         }
+         else
+         {
+            p=0;
+         }
+      }
+      if(dummy)
+      {
+        for(i=1;i<=size(L[d]);i++)
+        {
+           p=p+random(-100,100)*L[d][i];
+        }
+        dummy=goodChoice(BO,p);
+        if(!dummy)
+        {
+//--- found a suitable one
+           Z=p;
+        }
+      }
+      if(dummy)
+      {
+//--- did not find a suitable random linear combination either
+         if(dummy>errtype)
+         {
+           errtype=dummy;
+         }
+         list retlist=errtype,L[d];
+         return(retlist);
+      }
+   }
+   if(debugCoeff)
+   {
+     "----> In Coeff: Chosen hypersurface";
+     Z;
+   }
+//--- Step 2
+   C=Z;
+   for(i=0;i<b;i++)
+   {
+      C=C,powerI(simplify(reduce(L[i+1],std(Z)),2),b,b-i);
+   }
+   C=interred(C);
+
+   if(debugCoeff)
+   {
+     "----> In Coeff: J before saturation";
+     C;
+   }
+
+//--- Step 3
+   BO[1]=BO[1]+Z;
+   BO[2]=C;
+   for(i=1;i<=size(BO[4]);i++)
+   {
+      BO[6][i]=0;             // reset intersection indicator
+      BO[4][i]=BO[4][i]+Z;    // intersect the E_i
+      if(i<=ma)
+      {
+        BO[2]=sat(BO[2],BO[4][i]+BO[1])[1];
+                       // "strict transform" of J w.r.t E, not "total"
+      }
+   }
+   if(debugCoeff)
+   {
+     "----> In Coeff:";
+     " J after saturation:";
+     BO[2];
+   }
+   return(BO);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y,z),dp;
+
+   ideal W;
+   ideal J=z^2+x^2*y^2;
+   intvec b=0;
+   list E;
+   ideal abb=maxideal(1);
+   intvec v;
+   intvec w=-1;
+   matrix M;
+
+   list BO=W,J,b,E,abb,v,w,M;
+
+   Coeff(BO,2);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc goodChoice(list BO, poly p)
+"Internal procedure - no help and no example available
+"
+{
+//---------------------------------------------------------------------------
+// test whether new W is smooth
+//---------------------------------------------------------------------------
+   ideal W=BO[1]+ideal(p);
+   if(size(reduce(p,std(BO[1])))==0)
+   {
+//--- p is already in BO[1], i.e. does not define a hypersurface in W
+     return(1);
+   }
+   if(dim(std(slocusE(W)))>=0)
+//   if(dim(timeStd(slocusE(W),20))>=0)
+   {
+//--- new W would not be smooth
+     return(1);
+   }
+   if(size(BO[4])==0)
+   {
+//--- E is empty, no further tests necessary
+     return(0);
+   }
+//--------------------------------------------------------------------------
+// test whether the hypersurface meets the E_i transversally
+//--------------------------------------------------------------------------
+   list E=BO[4];
+   int i,d;
+   ideal T=W;
+   ideal Tstd=std(T);
+   d=nvars(basering)-dim(Tstd)+1;
+   ideal M;
+   for(i=1;i<=size(E);i++)
+   {
+      T=W,E[i];
+      M=minor(jacob(T),d,Tstd)+T;
+      M=std(M);
+      if(deg(M[1])>0)
+      {
+//--- intersection not transversal
+        return(2);
+      }
+   }
+//--------------------------------------------------------------------------
+// test whether the new E_i have normal crossings
+//--------------------------------------------------------------------------
+   for(i=1;i<=size(E);i++)
+   {
+      E[i]=E[i],p;
+   }
+   if(normalCross(E))
+   {
+     return(0);
+   }
+   else
+   {
+     return(2);
+   }
+}
+//////////////////////////////////////////////////////////////////////////////
+
+proc showBO(list BO)
+"USAGE:  showBO(BO);
+@*        BO=basic object, a list: ideal W,
+@*                                  ideal J,
+@*                                  intvec b (already truncated for Coeff),
+@*                                  list Ex  (already truncated for Coeff),
+@*                                  ideal ab,
+@*                                  intvec v,
+@*                                  intvec w (already truncated for Coeff),
+@*                                  matrix M
+RETURN:   nothing, only pretty printing
+EXAMPLE:  none
+"
+{
+  "                       ";
+  "==== W: ";BO[1];"      ";
+  "==== J: ";BO[2];"      ";
+  int i;
+  list M;
+  for(i=1;i<=size(BO[4]);i++)
+  {
+    M[i]=ideal(BO[4][i]);
+  }
+  "==== E: ";print(M);"   ";
+  "==== Intersection"; print(BO[8]);"     ";
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc max(int i,int j)
+"Internal procedure - no help and no example available
+"
+{
+//--- why is there no proc for max in general.lib?
+  if(i>j){return(i);}
+  return(j);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc min(int i,int j)
+"Internal procedure - no help and no example available
+"
+{
+//--- why is there no proc for max in general.lib?
+  if(i<j){return(i);}
+  return(j);
+}
+//////////////////////////////////////////////////////////////////////////////
+////////////////////////    main procedure    ////////////////////////////////
+//////////////////////////////////////////////////////////////////////////////
+proc resolve(ideal J, list #)
+"USAGE:  resolve (J); or resolve (J,i[,k]);
+@*       J ideal
+@*       i,k int
+COMPUTE: a resolution of J,
+@*       if i > 0 debugging is turned on according to the following switches:
+@*       j1: value 0 or 1; turn off or on correctness checks in all steps
+@*       j2: value 0 or 2; turn off or on debugCenter
+@*       j3: value 0 or 4; turn off or on debugBlowUp
+@*       j4: value 0 or 8; turn off or on debugCoeff
+@*       j5: value 0 or 16:turn off or on debugging of Intersection with E^-
+@*       j6: value 0 or 32:turn off or on stop after pass throught the loop
+@*       i=j1+j2+j3+j4+j5+j6
+RETURN:  a list l of 2 lists of rings
+         l[1][i] is a ring containing a basic object BO, the result of the
+         resolution.
+         l[2] contains all rings which occured during the resolution process
+EXAMPLE: example resolve;  shows an example
+"
+{
+//----------------------------------------------------------------------------
+// Initialization and sanity checks
+//----------------------------------------------------------------------------
+   def R=basering;
+   list allRings;
+   allRings[1]=R;
+   list endRings;
+   module path=[0,-1];
+   ideal W;
+   list E;
+   ideal abb=maxideal(1);
+   intvec v;
+   intvec bvec;
+   intvec w=-1;
+   matrix intE;
+   int extra,bm;
+   if(defined(BO)){kill(BO);}
+   if(defined(cent)){kill(cent);}
+
+   ideal Jrad=equiRadical(J);
+   if(size(reduce(Jrad,std(J)))!=0)
+   {
+      "WARNING! The input is not reduced or not equidimensional!";
+      "We will continue with the reduced top-dimensional part of input";
+      J=Jrad;
+   }
+
+   int i,j,debu,loca,locaT,ftemp,debugResolve,smooth;
+//--- switches for local and for debugging may occur in any order
+   i=size(#);
+   extra=3;
+   for(j=1;j<=i;j++)
+   {
+     if(typeof(#[j])=="int")
+     {
+       debugResolve=#[j];
+//--- debu: debug switch for resolve, smallest bit in debugResolve
+       debu=debugResolve mod 2;
+     }
+     else
+     {
+        if(#[j]=="M")
+        {
+           bm=1;
+           ERROR("Not implemented yet");
+        }
+        if(#[j]=="E"){extra=0;}
+        if(#[j]=="A"){extra=2;}
+        if(#[j]=="K"){extra=3;}
+        if(#[j]=="L"){loca=1;}
+     }
+   }
+   if(loca)
+   {
+      list qs=minAssGTZ(J);
+      ideal K=ideal(1);
+      for(j=1;j<=size(qs);j++)
+      {
+         if(size(reduce(qs[j],std(maxideal(1))))==0)
+         {
+            K=intersect(K,qs[j]);
+         }
+      }
+      J=K;
+      list qr=minAssGTZ(slocus(J));
+      K=ideal(1);
+      for(j=1;j<=size(qr);j++)
+      {
+         if(size(reduce(qr[j],std(maxideal(1))))!=0)
+         {
+            K=intersect(K,qr[j]);
+            smooth++;
+         }
+         else
+         {
+            if(dim(std(qr[j]))>0){loca=0;}
+//---- test for isolated singularity at 0
+         }
+      }
+      K=std(K);
+//---- if deg(K[1])==0 the point 0 is on all components of the singular
+//---- locus and we can work globally
+      if(smooth==size(qr)){smooth=-1;}
+//---- the point 0 is not on the singular locus
+      if((deg(K[1])>0)&&(smooth>=0)&&(!loca))
+      {
+         locaT=1;
+         poly @p;
+         for(j=1;j<=size(K);j++)
+         {
+            if(jet(K[j],0)!=0)
+            {
+               @p=K[j];
+               break;
+            }
+         }
+         export(@p);
+      }
+      if((loca)&&(!smooth)){loca=0;}
+//---- the case that 0 is isolated singularity and the only singular point
+   }
+   export(locaT);
+//---In case of option "L" the following holds
+//---loca=0 and locaT=0  we perform the global case
+//---loca !=0: 0 is isolated singular point, but there are other singularities
+//---locaT!=0: O is singular point, but not isolated, and there is a componente//---          of the singular locus not containing 0
+
+//--- if necessary, set the corresponding debugFlags
+   if(defined(debugResolve))
+   {
+//--- 2nd bit from the right
+     int debugCenter=(debugResolve div 2) mod 2;
+     export debugCenter;
+//--- 3rd bit from the right
+     int debugBlowUp=(debugResolve div 4) mod 2;
+     export debugBlowUp;
+//--- 4th bit from the right
+     int debugCoeff=(debugResolve div 8) mod 2;
+     export debugCoeff;
+//--- 5th bit from the right
+     int debug_Inters_E=(debugResolve div 16) mod 2;
+     export debug_Inters_E;
+//--- 6th bit from the right
+     int praes_stop=(debugResolve div 32) mod 2;
+   }
+//--- set the correct attributes to J for speed ups
+   if( typeof(attrib(J,"isEqui"))!="int" )
+   {
+      if(size(J)==1)
+      {
+         attrib(J,"isEqui",1);
+      }
+      else
+      {
+         attrib(J,"isEqui",0);
+      }
+   }
+   if(size(J)==1)
+   {
+      attrib(J,"isHy",1);
+   }
+   else
+   {
+      attrib(J,"isHy",0);
+   }
+//--- create the BO
+   list BO=W,J,bvec,E,abb,v,w,intE;
+   if(defined(invSat)){kill invSat;}
+   list invSat=ideal(0),intvec(0);
+   export(invSat);
+   if(bm)
+   {
+     intmat invmat[2][1]=0,-1;
+     BO[9]=invmat;
+   }
+   else
+   {
+     BO[9]=intvec(0);
+   }
+   export BO;
+   list tmpList;
+   int blo;
+   int k,Ecount,tmpPtr;
+   i=0;
+   if(smooth==-1)
+   {
+      endRings[1]=R;
+      list result=endRings,allRings;
+      if(debu)
+      {
+         "============= result will be tested ==========";
+         "                                              ";
+         "the number of charts obtained:",size(endRings);
+         "=============     result is o.k.    ==========";
+      }
+      kill debugCenter,debugBlowUp,debugCoeff,debug_Inters_E;
+      return(result);
+   }
+//-----------------------------------------------------------------------------
+// While there are rings to be considered, determine center and blow up
+//-----------------------------------------------------------------------------
+   while(i<size(allRings))
+   {
+      i++;
+      def S=allRings[i];
+      setring S;
+      list pr;
+      ideal Jstd=std(BO[2]);
+//-----------------------------------------------------------------------------
+// Determine Center
+//-----------------------------------------------------------------------------
+      if(i==1)
+      {
+         list deltaL=DeltaList(BO);
+         ideal sL=radical(deltaL[size(deltaL)]);
+         if((deg(std(slocus(sL))[1])==0)&&(size(minAssGTZ(sL))==1))
+         {
+            list @ce=sL,intvec(-1),intvec(0),intvec(0);
+            ideal cent=@ce[1];
+         }
+      }
+//--- before computing a center, check whether we have a stored one
+      if(size(BO)>9)
+      {
+         while(size(BO[10])>0)
+         {
+            list @ce=BO[10][1];
+//--- check of the center
+           // @ce=correctC(BO,@ce,bm);
+//--- use stored center
+            BO[10]=delete(BO[10],1);
+            if(size(@ce[1])==0)
+            {
+//--- stored center was not ok
+              continue;
+            }
+            tmpPtr=0;
+            for(Ecount=1;Ecount <= size(@ce[2]); Ecount++)
+            {
+              if(@ce[2][Ecount]>-1)
+              {
+                tmpPtr=tmpPtr+@ce[2][Ecount];
+              }
+              else
+              {
+                @ce[2][Ecount]=size(BO[4])-tmpPtr-1;
+                for(int cnthlp=1;cnthlp<=size(BO[10]);cnthlp++)
+                {
+                   BO[10][cnthlp][2][Ecount]=@ce[2][Ecount];
+                }
+                kill cnthlp;
+                break;
+              }
+            }
+            if(Ecount<size(@ce[2]))
+            {
+              for(tmpPtr=Ecount+1;tmpPtr<=size(@ce[2]);tmpPtr++)
+              {
+                @ce[2][tmpPtr]=0;
+                for(int cnthlp=1;cnthlp<=size(BO[10]);cnthlp++)
+                {
+                   BO[10][cnthlp][2][tmpPtr]=@ce[2][tmpPtr];
+                }
+                kill cnthlp;
+              }
+            }
+            break;
+         }
+         if(defined(@ce))
+         {
+           if(size(@ce[1])==0)
+           {
+              kill @ce;
+           }
+           else
+           {
+              ideal cent=@ce[1];
+           }
+         }
+         if(size(BO[10])==0)
+         {
+//--- previously had stored centers, all have been used; we need to clean up
+            BO=delete(BO,10);
+         }
+      }
+      if((loca)&&(i==1))
+      {
+//--- local case: initial step is blow-up in origin
+         if(defined(@ce)){kill @ce;}
+         if(defined(cent)){kill cent;}
+         if(size(reduce(slocusE(BO[2]),std(maxideal(1))))==0)
+         {
+            list @ce=maxideal(1),intvec(-1),intvec(0),intvec(0);
+         }
+         else
+         {
+            list @ce=BO[2],intvec(-1),intvec(1),intvec(0);
+         }
+         ideal cent=@ce[1];
+      }
+      if(((loca)||(locaT))&&(i!=1))
+      {
+         int JmeetsE;
+         for(j=1;j<=size(BO[4]);j++)
+         {
+            if(deg(std(BO[2]+BO[4][j])[1])!=0)
+            {
+               JmeetsE=1;
+               break;
+            }
+         }
+         if(!JmeetsE)
+         {
+            list @ce=BO[2],intvec(-1),intvec(1),intvec(0);
+            ideal cent=@ce[1];
+         }
+         kill JmeetsE;
+      }
+      if((locaT)&&(!defined(@ce)))
+      {
+          if(@p!=1)
+          {
+             list tr=minAssGTZ(slocusE(BO[2]));
+             ideal L=ideal(1);
+             for(j=1;j<=size(tr);j++)
+             {
+                if(size(reduce(ideal(@p),std(tr[j])))==0)
+                {
+                   L=intersect(L,tr[j]);
+                }
+             }
+             L=std(L);
+             if(deg(L[1])==0)
+             {
+                @p=1;
+             }
+             else
+             {
+               ideal fac=factorize(@p,1);
+               if(size(fac)==1)
+               {
+                 @p=fac[1];
+               }
+               else
+               {
+                  for(j=1;j<=size(fac);j++)
+                  {
+                     if(reduce(fac[j],L)==0)
+                     {
+                        @p=fac[j];
+                        break;
+                     }
+                  }
+               }
+             }
+             kill tr,L;
+          }
+          execute("ring R1=("+charstr(S)+"),(@z,"+varstr(S)+"),dp;");
+          poly p=imap(S,@p);
+          list BO=imap(S,BO);
+          list invSat=imap(S,invSat);
+          export(invSat);
+          ideal te=std(BO[2]);
+          BO[1]=BO[1]+ideal(@z*p-1);
+          BO[2]=BO[2]+ideal(@z*p-1);
+          for(j=1;j<=size(BO[4]);j++)
+          {
+             BO[4][j]=BO[4][j]+ideal(@z*p-1);
+          }
+//--- for computation of center: drop components not meeting the Ei
+          def BO2=BO;
+          list qs=minAssGTZ(BO2[2]);
+          ideal K=ideal(1);
+          for(j=1;j<=size(qs);j++)
+          {
+             if(CompMeetsE(qs[j],BO2[4]))
+             {
+                K=intersect(K,qs[j]);
+             }
+          }
+          BO2[2]=K;
+//--- check whether we are done
+          if(deg(std(BO2[2])[1])==0)
+          {
+             list @ce=BO[2],intvec(-1),intvec(1),intvec(0);
+          }
+          if(!defined(@ce))
+          {
+             if(bm)
+             {
+                list @ce=CenterBM(BO2);
+             }
+             else
+             {
+                list @ce=CenterBO(BO2);
+             }
+          }
+//--- if computation of center returned BO2[2], we are done
+//--- ==> set @ce to BO[2], because later checks work with BO instead of BO2
+          if((size(reduce(@ce[1],std(BO2[2])))==0)&&
+             (size(reduce(BO2[2],std(@ce[1])))==0))
+          {
+             @ce[1]=BO[2];
+          }
+          if(size(specialReduce(@ce[1],te,p))==0)
+          {
+             BO=imap(S,BO);
+             @ce[1]=BO[2];
+          }
+          else
+          {
+             //@ce=correctC(BO,@ce,bm);
+             @ce[1]=eliminate(@ce[1],@z);
+          }
+          setring S;
+          list @ce=imap(R1,@ce);
+          kill R1;
+
+         if((size(reduce(BO[2],std(@ce[1])))==0)
+             &&(size(reduce(@ce[1],Jstd))==0))
+         {
+//--- J and center coincide
+            pr[1]=@ce[1];
+            ideal cent=@ce[1];
+         }
+         else
+         {
+//--- decompose center and use first component
+            pr=minAssGTZ(@ce[1]);
+               if(size(reduce(@p,std(pr[1])))==0){"Achtung";~;}
+               if(deg(std(slocus(pr[1]))[1])>0){"singulaer";~;}
+            ideal cent=pr[1];
+         }
+         if(size(pr)>1)
+         {
+//--- store the other components
+            for(k=2;k<=size(pr);k++)
+            {
+               if(size(reduce(@p,std(pr[k])))==0){"Achtung";~;}
+               if(deg(std(slocus(pr[k]))[1])>0){"singulaer";~;}
+               if(size(reduce(@p,std(pr[k])))!=0)
+               {
+                  tmpList[size(tmpList)+1]=list(pr[k],@ce[2],@ce[3],@ce[4]);
+               }
+            }
+            BO[10]=tmpList;
+            kill tmpList;
+            list tmpList;
+         }
+      }
+      if(!defined(@ce))
+      {
+//--- no previously determined center, we need to compute one
+         if(loca)
+         {
+//--- local case: center should be inside exceptional locus
+            ideal Ex=ideal(1);
+            k=0;
+            for(j=1;j<=size(BO[4]);j++)
+            {
+               if(deg(BO[4][j][1])!=0)
+               {
+                 Ex=Ex*BO[4][j];   //----!!!!hier evtl. Durchschnitt???
+                 k++;
+               }
+            }
+//--- for computation of center: drop components not meeting the Ei
+            list BOloc=BO;
+            list qs=minAssGTZ(BOloc[2]);
+            ideal K=ideal(1);
+            for(j=1;j<=size(qs);j++)
+            {
+              if(CompMeetsE(qs[j],BOloc[4]))
+              {
+                 K=intersect(K,qs[j]);
+              }
+            }
+            BOloc[2]=K;
+//--- check whether we are done
+            if(deg(std(BOloc[2])[1])==0)
+            {
+               list @ce=BO[2],intvec(-1),intvec(1),intvec(0);
+            }
+            if(!defined(@ce))
+            {
+              if(BO[3][1]!=0)
+              {
+                 BOloc[2]=BO[2]+Ex^((BO[3][1] div k)+1);//!!!!Vereinfachen???
+              }
+              else
+              {
+                 BOloc[2]=BO[2]+Ex^((size(DeltaList(BO)) div k)+1);
+              }
+              if(bm)
+              {
+                 list @ce=CenterBM(BOloc);
+              }
+              else
+              {
+                 list @ce=CenterBO(BOloc);
+              }
+              if(size(reduce(Ex,std(@ce[1])))!=0)
+              {
+                 list tempPr=minAssGTZ(@ce[1]);
+                 for(k=size(tempPr);k>=1;k--)
+                 {
+                    if(size(reduce(Ex,std(tempPr[k])))!=0)
+                    {
+                      tempPr=delete(tempPr,k);
+                    }
+                 }
+                 @ce[1]=1;
+                 for(k=1;k<=size(tempPr);k++)
+                 {
+                    @ce[1]=intersect(@ce[1],tempPr[k]);
+                 }
+                 if(deg(std(@ce[1])[1])==0)
+                 {
+                    @ce[1]=BO[2];
+                 }
+              }
+            }
+//--- test whether we are done
+            if(size(reduce(slocusE(BO[2]),std(@ce[1])))!=0)
+            {
+               if(transversalT(BO[2],BO[4]))
+               {
+                  if(defined(E)){kill E;}
+                  list E=BO[4];
+                  for(j=1;j<=size(E);j++){if(deg(E[j][1])>0){E[j]=E[j]+BO[2];}}
+                  if(normalCross(E))
+                  {
+                     @ce[1]=BO[2];
+                  }
+                  kill E;
+               }
+            }
+         }
+         else
+         {
+//--- non-local
+            if(bm)
+            {
+               list @ce=CenterBM(BO);
+            }
+            else
+            {
+               list @ce=CenterBO(BO);
+            }
+//--- check of the center
+            //@ce=correctC(BO,@ce,bm);
+            if((size(@ce[1])==0)&&(size(@ce[4])<(size(@ce[3])-1)))
+            {
+               intvec xxx=@ce[3];
+               xxx=xxx[1..size(@ce[4])];
+               @ce[3]=xxx;
+               xxx=@ce[2];
+               xxx=xxx[1..size(@ce[4])];
+               @ce[2]=xxx;
+               kill xxx;
+            }
+         }
+         if((size(reduce(BO[2],std(@ce[1])))==0)
+             &&(size(reduce(@ce[1],Jstd))==0))
+         {
+//--- J and center coincide
+            pr[1]=@ce[1];
+            ideal cent=@ce[1];
+         }
+         else
+         {
+//--- decompose center and use first component
+            pr=minAssGTZ(@ce[1]);
+            ideal cent=pr[1];
+         }
+         if(size(pr)>1)
+         {
+//--- store the other components
+            for(k=2;k<=size(pr);k++)
+            {
+               tmpList[k-1]=list(pr[k],@ce[2],@ce[3],@ce[4]);
+            }
+            BO[10]=tmpList;
+            kill tmpList;
+            list tmpList;
+         }
+      }
+//--- do not forget to update BO[7] and BO[3]
+      export cent;
+      BO[7]=@ce[2];
+      BO[3]=@ce[3];
+      if((loca||locaT)&&(size(@ce)<4)){@ce[4]=0;} //Provisorium !!!
+      if((size(@ce[4])<size(@ce[2])-1)||(size(@ce[4])<size(@ce[3])-1))
+      {
+        if((deg(std(@ce[1])[1])==0)&&(deg(std(BO[2])[1])==0))
+        {
+           intvec nullvec;
+           nullvec[size(@ce[2])-1]=0;
+           @ce[4]=nullvec;
+           kill nullvec;
+        }
+        else
+        {
+           "ERROR:@ce[4] hat falsche Laenge - nicht-trivialer Fall";
+           ~;
+        }
+      }
+      if((typeof(@ce[4])=="intvec") || (typeof(@ce[4])=="intmat"))
+      {
+        BO[9]=@ce[4];
+      }
+//---------------------------------------------------------------------------
+// various checks and debug output
+//---------------------------------------------------------------------------
+      if((debu) || (praes_stop))
+      {
+//--- Show BO of this step
+         "++++++++++++++    BO    +++++++++++++++++++++++";
+         size(endRings);
+         size(allRings);
+         i;
+         "+++++++++++++++++++++++++++++++++++++++++++++++";
+         showBO(BO);
+         "-------  Center ------------";
+         interred(cent);
+         "----------------------------";
+      }
+      if(praes_stop)
+      {
+         ~;
+      }
+      if(debu)
+      {
+//--- various checks, see output for comments
+         if(size(BO[1])>0)
+         {
+            if(deg(BO[1][1])==0)
+            {
+               "!!!  W is empty  !!!";
+               path;
+               setring R;
+               kill S;
+               list result=endRings,allRings;
+               return(result);
+            }
+            if(deg(std(slocusE(BO[1]))[1])>0)
+            {
+               "!!!  W not smooth  !!!";
+               path;
+               setring R;
+               kill S;
+               list result=endRings,allRings;
+               return(result);
+            }
+         }
+         if((!loca)&&(!locaT))
+         {
+            if(deg(std(slocusE(cent+BO[1]))[1])>0)
+            {
+               "!!!  Center not smooth  !!!";
+               path;
+               std(cent+BO[1]);
+               ~;
+               setring R;
+               kill S;
+               list result=endRings,allRings;
+               return(result);
+            }
+         }
+         for(j=1;j<=size(BO[4]);j++)
+         {
+            if(deg(BO[4][j][1])>0)
+            {
+               if(deg(std(slocusE(BO[4][j]+BO[1]))[1])>0)
+               {
+                  "!!!  exceptional divisor is not smooth  !!!";
+                  path;
+                  setring R;
+                  kill S;
+                  list result=endRings,allRings;
+                  return(result);
+               }
+            }
+         }
+         if((!loca)&&(!locaT))
+         {
+            if((norC(BO,cent))&&(size(reduce(cent,Jstd))!=0))
+            {
+               "!!!  this chart is already finished  !!!";
+               cent=BO[2];
+               ~;
+            }
+         }
+      }
+//----------------------------------------------------------------------------
+// Do the blow up
+//----------------------------------------------------------------------------
+//!!!! Change this as soon as there is time!!!
+//!!!! quick and dirty bug fix for old shortcut which has not yet been killed
+if((dim(std(cent))==0)&&defined(shortcut)) {kill shortcut;}
+//!!! end of bugfix
+      if(size(reduce(cent,Jstd))!=0)
+      {
+//--- center does not equal J
+         tmpList=blowUpBO(BO,cent,extra);
+         if((debu)&&(!loca)&&(!locaT))
+         {
+//--- test it, if debu is set
+            if(!testBlowUp(BO,cent,tmpList,i,extra))
+            {
+               "non-redundant chart has been killed!";
+               ~;
+            }
+         }
+//--- extend the list of all rings
+         allRings[size(allRings)+1..size(allRings)+size(tmpList)]=
+                         tmpList[1..size(tmpList)];
+         for(j=1;j<=size(tmpList);j++)
+         {
+            def Q=allRings[size(allRings)-j+1];
+            setring Q;
+            def path=imap(S,path);
+            path=path,[i,size(tmpList)-j+1];
+            export path;
+            setring S;
+            kill Q;
+         }
+         kill tmpList;
+         list tmpList;
+      }
+      else
+      {
+//--- center equals J
+           k=0;
+           for(j=1;j<=size(BO[6]);j++)
+           {
+              if(BO[6][j]!=1)
+              {
+//--- there is an E_i which meets J in this chart
+                k=1;
+                break;
+              }
+           }
+           if(k)
+           {
+//--- chart finished, non-redundant
+              endRings[size(endRings)+1]=S;
+           }
+      }
+      kill pr;
+      setring R;
+      kill S;
+   }
+//---------------------------------------------------------------------------
+// set up the result, test it (if debu is set) and return it
+//---------------------------------------------------------------------------
+   list result=endRings,allRings;
+   if(debu)
+   {
+      "============= result will be tested ==========";
+      "                                              ";
+      "the number of charts obtained:",size(endRings);
+      if(locaT){loca=2;}
+      int tes=testRes(J,endRings,loca);
+      if(tes)
+      {
+         "=============     result is o.k.    ==========";
+      }
+      else
+      {
+         "============     result is wrong    =========="; ~;
+      }
+   }
+   kill debugCenter,debugBlowUp,debugCoeff,debug_Inters_E;
+   if(locaT){kill @p;}
+   kill locaT;
+   return(result);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y,z),dp;
+   ideal J=x3+y5+yz2+xy4;
+   list L=resolve(J,1);
+   def Q=L[1][7];
+   setring Q;
+   showBO(BO);
+}
+//////////////////////////////////////////////////////////////////////////
+//static
+proc CompMeetsE(ideal J, list E)
+"Internal procedure - no help and no example available
+"
+{
+   int i;
+   for(i=1;i<=size(E);i++)
+   {
+      if(deg(std(E[i])[1])!=0)
+      {
+         if(deg(std(J+E[i])[1])!=0)
+         {
+            return(1);
+         }
+      }
+   }
+   return(0);
+}
+
+//========================================================================
+//--------------  procedures for testing the result ----------------------
+//                (not yet commented)
+//========================================================================
+
+//////////////////////////////////////////////////////////////////////////
+static
+proc testRes(ideal J,list L,int loca)
+"Internal procedure - no help and no example available
+"
+{
+   int loc;
+   if(defined(locaT)){loc=locaT;}
+   if(loc){loca=0;}
+   def R=basering;
+   ideal M=maxideal(1);
+   int i,j,tr;
+   for(i=1;i<=size(L);i++)
+   {
+      def Q=L[i];
+      setring Q;
+      ideal J=BO[2];
+      list E=BO[4];
+      map phi=R,BO[5];
+      ideal K=phi(J)+BO[1];
+      ideal stTK=std(K);
+
+      if(loca)
+      {
+         ideal M=phi(M)+BO[1];
+         ideal stTM=std(M);
+      }
+      for(j=1;j<=size(E);j++)
+      {
+         if(deg(E[j][1])>0)
+         {
+            stTK=sat(stTK,E[j])[1];
+         }
+         if(loca)
+         {
+            stTM=sat(stTM,E[j])[1];
+         }
+      }
+      ideal sL=slocusE(J);
+      if(loca){sL=sL+stTM;}
+      ideal sLstd=std(sL);
+      if(deg(sLstd[1])>0)
+      {
+         if(!loc)
+         {
+            "J is not smooth";i;
+            setring R;
+            return(0);
+         }
+         if(size(reduce(@p,std(radical(sLstd))))>0)
+         {
+            "J is not smooth";i;
+            setring R;
+            return(0);
+         }
+      }
+      if(!((size(reduce(J,std(stTK)))==0)
+           &&(size(reduce(stTK,std(J)))==0)))
+      {
+         "map is wrong";i;
+         setring R;
+         return(0);
+      }
+      if(loc){tr=transversalT(J,E,@p);}
+      else{tr=transversalT(J,E);}
+      if(!tr)
+      {
+         "E not transversal with J";i;
+         setring R;
+         return(0);
+      }
+      if(!normalCross(E))
+      {
+         "E not normal crossings";i;
+         setring R;
+         return(0);
+      }
+      for(j=1;j<=size(E);j++)
+      {
+         if(deg(E[j][1])>0){E[j]=E[j]+J;}
+      }
+      if(!normalCross(E))
+      {
+         "E not normal crossings with J";i;
+         setring R;
+         return(0);
+      }                  
+      kill J,E,phi,K,stTK;
+      if(loca){kill M,stTM;}
+      setring R;
+      kill Q;
+   }
+   return(1);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc testBlowUp(list BO,ideal cent,list tmpList, int j, int extra)
+{
+   def R=basering;
+   int n=nvars(basering);
+   int i;
+   if((extra!=3)&&(extra!=2))
+   {
+      ideal K=BO[1],BO[2],cent;
+      for(i=1;i<=size(BO[4]);i++)
+      {
+        K=K,BO[4][i];
+      }
+      list N=findvars(K,0);
+      //list N=findvars(BO[2],0);
+      if(size(N[1])<n)
+      {
+         string newvar=string(N[1]);
+         execute("ring R1=("+charstr(R)+"),("+newvar+"),dp;");
+         list BO=imap(R,BO);
+         ideal cent=imap(R,cent);
+         n=nvars(R1);
+      }
+      else
+      {
+         def R1=basering;
+      }
+   }
+   else
+   {
+      def R1=basering;
+   }
+
+   i=0;
+   ideal T=cent;
+   ideal TW;
+   for(i=1;i<=size(tmpList);i++)
+   {
+      def Q=tmpList[i];
+      setring Q;
+      map phi=R1,lastMap;
+      ideal TE=radical(slocusE(BO[2]));
+      setring R1;
+      TW=preimage(Q,phi,TE);
+      T=intersect(T,TW);
+      kill Q;
+   }
+   ideal sL=intersect(slocusE(BO[2]),cent);
+   if(size(reduce(sL,std(radical(T))))>0){setring R;return(0);}
+   if(size(reduce(T,std(radical(sL))))>0){setring R;return(0);}
+   setring R;
+   return(1);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc normalCross(list E,list #)
+"Internal procedure - no help and no example available
+"
+{
+   int loc;
+   if((defined(locaT))&&(defined(@p)))
+   {
+      loc=1;
+      ideal pp=@p;
+   }
+   int i,d,j;
+   int n=nvars(basering);
+   list E1,E2;
+   ideal K,M,Estd,cent;
+   intvec v,w;
+   if(size(#)>0){cent=#[1];}
+
+   for(i=1;i<=size(E);i++)
+   {
+      Estd=std(E[i]);
+      if(deg(Estd[1])>0)
+      {
+         E1[size(E1)+1]=Estd;
+      }
+   }
+   E=E1;
+   for(i=1;i<=size(E);i++)
+   {
+      v=i;
+      E1[i]=list(E[i],v);
+   }
+   list ll;
+   int re=1;
+   int ok;
+   while(size(E1)>0)
+   {
+      K=E1[1][1];
+      v=E1[1][2];
+      attrib(K,"isSB",1);
+      E1=delete(E1,1);
+      d=n-dim(K);
+      M=minor(jacob(K),d)+K;
+      if(deg(std(M)[1])>0)
+      {
+         if(size(#)>0)
+         {
+            if(size(reduce(M,std(cent)))>0)
+            {
+               ll[size(ll)+1]=std(M);
+            }
+            else
+            {
+               ok=1;
+            }
+         }
+         if(!loc)
+         {
+            re=0;
+         }
+         else
+         {
+            if(size(reduce(pp,std(radical(M))))>0){re=0;}
+         }
+      }
+      for(i=1;i<=size(E);i++)
+      {
+         for(j=1;j<=size(v);j++){if(v[j]==i){break;}}
+         if(j<=size(v)){if(v[j]==i){i++;continue;}}
+         Estd=std(K+E[i]);
+         w=v;
+         if(deg(Estd[1])==0){i++;continue;}
+         if(d==n-dim(Estd))
+         {
+            if(size(#)>0)
+            {
+               if(size(reduce(Estd,std(cent)))>0)
+               {
+                  ll[size(ll)+1]=Estd;
+               }
+               else
+               {
+                  ok=1;
+               }
+            }
+            if(!loc)
+            {
+               re=0;
+            }
+            else
+            {
+               if(size(reduce(pp,std(radical(M))))>0){re=0;}
+            }
+         }
+         w[size(w)+1]=i;
+         E2[size(E2)+1]=list(Estd,w);
+      }
+      if(size(E2)>0)
+      {
+         if(size(E1)>0)
+         {
+            E1[size(E1)+1..size(E1)+size(E2)]=E2[1..size(E2)];
+         }
+         else
+         {
+            E1=E2;
+         }
+      }
+      kill E2;
+      list E2;
+   }
+/*
+   if((!ok)&&(!re)&&(size(#)==1))
+   {
+
+      "the center is wrong";
+      "it could be one of the following list";
+      ll;
+       ~;
+   }
+*/
+   if((!ok)&&(!re)&&(size(#)==2))
+   {
+      return(2);   //for Center correction
+   }
+   return(re);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc normalCrossB(ideal J,list E,ideal V)
+"Internal procedure - no help and no example available
+"
+{
+   int i,d,j;
+   int n=nvars(basering);
+   list E1,E2;
+   ideal K,M,Estd;
+   intvec v,w;
+
+   for(i=1;i<=size(E);i++)
+   {
+      Estd=std(E[i]+J);
+      if(deg(Estd[1])>0)
+      {
+         E1[size(E1)+1]=Estd;
+      }
+   }
+   E=E1;
+   for(i=1;i<=size(E);i++)
+   {
+      v=i;
+      E1[i]=list(E[i],v);
+   }
+   list ll;
+   int re=1;
+
+   while((size(E1)>0)&&(re==1))
+   {
+      K=E1[1][1];
+      v=E1[1][2];
+      attrib(K,"isSB",1);
+      E1=delete(E1,1);
+      d=n-dim(K);
+      M=minor(jacob(K),d)+K;
+      if(deg(std(M+V)[1])>0)
+      {
+         re=0;
+         break;
+      }
+      for(i=1;i<=size(E);i++)
+      {
+         for(j=1;j<=size(v);j++){if(v[j]==i){break;}}
+         if(j<=size(v)){if(v[j]==i){i++;continue;}}
+         Estd=std(K+E[i]);
+         w=v;
+         if(deg(Estd[1])==0){i++;continue;}
+         if(d==n-dim(Estd))
+         {
+            if(deg(std(Estd+V)[1])>0)
+            {
+               re=0;
+               break;
+            }
+         }
+         w[size(w)+1]=i;
+         E2[size(E2)+1]=list(Estd,w);
+      }
+      if(size(E2)>0)
+      {
+         if(size(E1)>0)
+         {
+            E1[size(E1)+1..size(E1)+size(E2)]=E2[1..size(E2)];
+         }
+         else
+         {
+            E1=E2;
+         }
+      }
+      kill E2;
+      list E2;
+   }
+   return(re);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc norC(list BO,ideal cent)
+"Internal procedure - no help and no example available
+"
+{
+   int j;
+   list  E=BO[4];
+   ideal N=BO[2];
+   if(BO[3][1]>1){return(0);}
+   if(deg(std(slocusE(BO[2]))[1])>0){return(0);}
+   if(!transversalT(N,E)){return(0);}
+   for(j=1;j<=size(E);j++){if(deg(E[j][1])>0){E[j]=E[j]+N;}}
+   if(!normalCross(E,cent)){return(0);}
+   return(1);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc specialReduce(ideal I,ideal J,poly p)
+{
+   matrix M;
+   int i,j;
+   for(i=1;i<=ncols(I);i++)
+   {
+      M=coeffs(I[i],@z);
+      I[i]=0;
+      for(j=1;j<=nrows(M);j++)
+      {
+         I[i]=I[i]+M[j,1]*p^(nrows(M)-j);
+      }
+      I[i]=reduce(I[i],J);
+   }
+   return(I);
+}
Index: Singular/LIB/reszeta.lib
===================================================================
--- Singular/LIB/reszeta.lib	(revision 2e6eac218988a6cdb89b0be44b0a24dd62ac41a7)
+++ Singular/LIB/reszeta.lib	(revision 2e6eac218988a6cdb89b0be44b0a24dd62ac41a7)
@@ -0,0 +1,5230 @@
+//////////////////////////////////////////////////////////////////////////////
+version="$Id: reszeta.lib,v 1.2 2005-05-03 14:22:08 Singular Exp $";
+category="Commutative Algebra";
+info="
+LIBRARY:  zeta.lib       Zeta-function of Denef and Loeser
+
+AUTHORS:  A. Fruehbis-Krueger,  anne@mathematik.uni-kl.de,
+@*        G. Pfister,           pfister@mathematik.uni-kl.de
+
+MAIN PROCEDURES:
+intersectionDiv(L)   computes intersection form and genera of exceptional
+                     divisors (isolated singularities of surfaces)
+spectralNeg(L)       computes negative spectral numbers
+                     (isolated hypersurface singularity)
+zetaDL               computes Denef-Loeser zeta function
+                     (hypersurface singularity of dimension 2)
+
+AUXILLIARY PROCEDURES:
+collectDiv(L[,iv])   identify exceptional divisors in different charts
+                     (embedded and non-embedded case)
+prepEmbDiv(L[,b])    prepare list of divisors (including components
+                     of strict transform, embedded case)
+abstractR(L)         pass from embedded to non-embedded resolution
+";
+LIB "resol.lib";
+LIB "solve.lib";
+LIB "normal.lib";
+///////////////////////////////////////////////////////////////////////////////
+//      the repunit: ring R=0,x,dp;number n=10;(n^1031-1)/9;  is prim        //
+//      record:      number m=2;number k=m^20996011-1;                       //
+///////////////////////////////////////////////////////////////////////////////
+static
+proc spectral1(poly h,list re, list DL,intvec v, intvec n)
+"Internal procedure - no help and no example available
+"
+{
+//--- compute one spectral number
+//--- DL is output of prepEmbDiv
+   int i;
+   intvec w=computeH(h,re,DL);
+   number gw=number(w[1]+v[1])/number(n[1]);
+   for(i=2;i<=size(v);i++)
+   {
+      if(gw>number(w[i]+v[i])/number(n[i]))
+      {
+         gw=number(w[i]+v[i])/number(n[i]);
+      }
+   }
+   return(gw-1);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+
+proc spectralNeg(list re,list #)
+"USAGE:   spectralNeg(L);
+@*        L = list of rings
+ASSUME:   L is output of resolution of singularities
+RETURN:   list of numbers, each a spectral number in (-1,0]
+EXAMPLE:  example spectralNeg;  shows an example
+"
+{
+//-----------------------------------------------------------------------------
+// Initialization and Sanity Checks
+//-----------------------------------------------------------------------------
+   int i,j,l;
+   number bound;
+   list resu;
+   if(size(#)>0)
+   {
+//--- undocumented feature:
+//--- if # is not empty it computes numbers up to this bound,
+//--- not necessarily spectral numbers
+      bound=number(#[1]);
+   }
+//--- get list of embedded divisors
+   list DL=prepEmbDiv(re,1);
+   int k=1;
+   ideal I,delI;
+   number g;
+   int m=nvars(basering);
+//--- prepare the multiplicities of exceptional divisors N and nu
+   intvec v=computeV(re,DL);        // nu
+   intvec n=computeN(re,DL);        // N
+//---------------------------------------------------------------------------
+// start computation, first case separately, then loop
+//---------------------------------------------------------------------------
+   resu[1]=spectral1(1,re,DL,v,n);  // first number, corresponding to
+                                    // volume form itself
+   if(resu[1]>=bound)
+   {
+//--- exceeds bound ==> not a spectral number
+      resu=delete(resu,1);
+      return(resu);
+   }
+   delI=std(ideal(0));
+   while(k)
+   {
+//--- now run through all monomial x volume form, degree by degree
+      j++;
+      k=0;
+      I=maxideal(j);
+      I=reduce(I,delI);
+      for(i=1;i<=size(I);i++)
+      {
+//--- all monomials in degree j
+         g=spectral1(I[i],re,DL,v,n);
+         if(g<bound)
+         {
+//--- otherwise g exceeds bound ==> not a spectral number
+            k=1;
+            l=1;
+            while(resu[l]<g)
+            {
+               l++;
+               if(l==size(resu)+1){break;}
+            }
+            if(l==size(resu)+1){resu[size(resu)+1]=g;}
+            if(resu[l]!=g){resu=insert(resu,g,l-1);}
+         }
+         else
+         {
+            delI[size(delI)+1]=I[i];
+         }
+      }
+      attrib(delI,"isSB",1);
+   }
+   return(resu);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y,z),dp;
+   ideal I=x3+y4+z5;
+   list L=resolve(I,"K");
+   spectralNeg(L);
+   LIB"gaussman.lib";
+   ring r=0,(x,y,z),ds;
+   poly f=x3+y4+z5;
+   spectrum(f);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+static
+proc ordE(ideal J,ideal E,ideal W)
+"Internal procedure - no help and no example available
+"
+{
+//--- compute multiplicity of E in J -- embedded in W
+   int s;
+   if(size(J)==0){~;ERROR("ordE: J=0");}
+   ideal Estd=std(E+W);
+   ideal Epow=1;
+   ideal Jquot=1;
+   while(size(reduce(Jquot,Estd))!=0)
+   {
+      s++;
+      Epow=Epow*E;
+      Jquot=quotient(Epow+W,J);
+   }
+   return(s-1);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+static
+proc computeV(list re, list DL)
+"Internal procedure - no help and no example available
+"
+{
+//--- computes for every divisor E_i its multiplicity + 1 in pi^*(w)
+//--- w a non-vanishing 1-form
+//--- note: DL is output of prepEmbDiv
+
+//-----------------------------------------------------------------------------
+// Initialization
+//-----------------------------------------------------------------------------
+   def R=basering;
+   int i,j,k,n;
+   intvec v,w;
+   list iden=DL;
+   v[size(iden)]=0;
+
+//----------------------------------------------------------------------------
+// Run through all exceptional divisors
+//----------------------------------------------------------------------------
+   for(k=1;k<=size(iden);k++)
+   {
+      for(i=1;i<=size(iden[k]);i++)
+      {
+         if(defined(S)){kill S;}
+         def S=re[2][iden[k][i][1]];
+         setring S;
+         if((!v[k])&&(defined(EList)))
+         {
+            if(defined(II)){kill II;}
+//--- we might be embedded in a non-trivial BO[1]
+//--- take this into account when forming the jacobi-determinant
+            ideal II=jacobDet(BO[5],BO[1]);
+            if(size(II)!=0)
+            {
+                v[k]=ordE(II,EList[iden[k][i][2]],BO[1])+1;
+            }
+         }
+         setring R;
+      }
+   }
+   return(v);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y,z),dp;
+   ideal I=(x-y)*(x-z)*(y-z)-z4;
+   list re=resolve(I,1);
+   intvec v=computeV(re);
+   v;
+}
+
+///////////////////////////////////////////////////////////////////////////////
+static
+proc jacobDet(ideal I, ideal J)
+"Internal procedure - no help and no example available
+"
+{
+//--- Returns the Jacobian determinant of the morphism
+//--- K[x_1,...,x_m]--->K[y_1,...,y_n]/J defined by x_i ---> I_i.
+//--- Let basering=K[y_1,...,y_n], l=n-dim(basering/J),
+//--- I=<I_1,...,I_m>, J=<J_1,...,J_r>
+//--- For each subset v in {1,...,n} of l elements and
+//--- w in {1,...,r} of l elements
+//--- let K_v,w be the ideal generated by the n-l-minors of the matrix
+//--- (diff(I_i,y_j)+
+//---  \sum_k diff(I_i,y_v[k])*diff(J_w[k],y_j))_{j not in v  multiplied with
+//---                                 the determinant of (diff(J_w[i],y_v[j]))
+//--- the sum of all such ideals K_v,w plus J is returned.
+
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+   int n=nvars(basering);
+   int i,j,k;
+   intvec u,v,w,x;
+   matrix MI[ncols(I)][n]=jacob(I);
+   matrix N=unitmat(n);
+   matrix L;
+   ideal K=J;
+   if(size(J)==0)
+   {
+      K=minor(MI,n);
+   }
+
+//---------------------------------------------------------------------------
+// Do calculation as described above.
+// separately for case size(J)=1
+//---------------------------------------------------------------------------
+   if(size(J)==1)
+   {
+      matrix MJ[ncols(J)][n]=jacob(J);
+      N=concat(N,transpose(MJ));
+      v=1..n;
+      for(i=1;i<=n;i++)
+      {
+         L=transpose(permcol(N,i,n+1));
+         if(i==1){w=2..n;}
+         if(i==n){w=1..n-1;}
+         if((i!=1)&&(i!=n)){w=1..i-1,i+1..n;}
+         L=submat(L,v,w);
+         L=MI*L;
+         K=K+minor(L,n-1)*MJ[1,i];
+      }
+   }
+   if(size(J)>1)
+   {
+      matrix MJ[ncols(J)][n]=jacob(J);
+      matrix SMJ;
+      N=concat(N,transpose(MJ));
+      ideal Jstd=std(J);
+      int l=n-dim(Jstd);
+      int r=ncols(J);
+      list L1=indexSet(n,l);
+      list L2=indexSet(r,l);
+      for(i=1;i<=size(L1);i++)
+      {
+         for(j=1;j<=size(L2);j++)
+         {
+            for(k=1;k<=size(L1[i]);k++)
+            {
+               if(L1[i][k]){v[size(v)+1]=k;}
+            }
+            v=v[2..size(v)];
+            for(k=1;k<=size(L2[j]);k++)
+            {
+               if(L2[j][k]){w[size(w)+1]=k;}
+            }
+            w=w[2..size(w)];
+            SMJ=submat(MJ,w,v);
+            L=N;
+            for(k=1;k<=l;k++)
+            {
+               L=permcol(L,v[k],n+w[k]);
+            }
+            u=1..n;
+            x=1..n;
+            v=sort(v)[1];
+            for(k=l;k>=1;k--)
+            {
+               if(v[k])
+               {
+                  u=deleteInt(u,v[k],1);
+               }
+            }
+            L=transpose(submat(L,u,x));
+            L=MI*L;
+            K=K+minor(L,n-l)*det(SMJ);
+         }
+      }
+   }
+   return(K);
+}
+
+///////////////////////////////////////////////////////////////////////////////
+static
+proc computeH(ideal h,list re,list DL)
+"Internal procedure - no help and no example available
+"
+{
+//--- additional procedure to computeV, allows
+//--- computation for polynomial x volume form
+//--- by computing the contribution of the polynomial h
+//--- Note: DL is output of prepEmbDiv
+
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+   def R=basering;
+   ideal II=h;
+   list iden=DL;
+   def T=re[2][1];
+   setring T;
+   int i,k;
+   intvec v;
+   v[size(iden)]=0;
+   if(deg(II[1])==0){return(v);}
+//----------------------------------------------------------------------------
+// Run through all exceptional divisors
+//----------------------------------------------------------------------------
+   for(k=1;k<=size(iden);k++)
+   {
+      for(i=1;i<=size(iden[k]);i++)
+      {
+         if(defined(S)){kill S;}
+         def S=re[2][iden[k][i][1]];
+         setring S;
+         if((!v[k])&&(defined(EList)))
+         {
+            if(defined(JJ)){kill JJ;}
+            if(defined(phi)){kill phi;}
+            map phi=T,BO[5];
+            ideal JJ=phi(II);
+            if(size(JJ)!=0)
+            {
+               v[k]=ordE(JJ,EList[iden[k][i][2]],BO[1]);
+            }
+         }
+         setring R;
+      }
+   }
+   return(v);
+}
+
+//////////////////////////////////////////////////////////////////////////////
+static
+proc computeN(list re,list DL)
+"Internal procedure - no help and no example available
+"
+{
+//--- computes for every (Q-irred.) divisor E_i its multiplicity in f \circ pi
+//--- DL is output of prepEmbDiv
+
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+   def R=basering;
+   list iden=DL;
+   def T=re[2][1];
+   setring T;
+   ideal J=BO[2];
+   int i,k;
+   intvec v;
+   v[size(iden)]=0;
+//----------------------------------------------------------------------------
+// Run through all exceptional divisors
+//----------------------------------------------------------------------------
+   for(k=1;k<=size(iden);k++)
+   {
+      for(i=1;i<=size(iden[k]);i++)
+      {
+         if(defined(S)){kill S;}
+         def S=re[2][iden[k][i][1]];
+         setring S;
+         if((!v[k])&&(defined(EList)))
+         {
+            if(defined(II)){kill II;}
+            if(defined(phi)){kill phi;}
+            map phi=T,BO[5];
+            ideal II=phi(J);
+            if(size(II)!=0)
+            {
+               v[k]=ordE(II,EList[iden[k][i][2]],BO[1]);
+            }
+         }
+         setring R;
+      }
+   }
+   return(v);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y,z),dp;
+   ideal I=(x-y)*(x-z)*(y-z)-z4;
+   list re=resolve(I,1);
+   intvec v=computeN(re);
+   v;
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc countEijk(list re,list iden,intvec iv,list #)
+"Internal procedure - no help and no example available
+"
+{
+//--- count the number of points in the intersection of 3 exceptional
+//--- hyperplanes (of dimension 2) - one of them is allowed to be a component
+//--- of the strict transform
+
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+   int i,j,k,comPa,numPts,localCase;
+   intvec ituple,jtuple,ktuple;
+   list chList,tmpList;
+   def R=basering;
+   if(size(#)>0)
+   {
+      if(string(#[1])=="local")
+      {
+         localCase=1;
+      }
+   }
+//----------------------------------------------------------------------------
+// Find common charts
+//----------------------------------------------------------------------------
+   for(i=1;i<=size(iden[iv[1]]);i++)
+   {
+//--- find common charts - only for final charts
+      if(defined(S)) {kill S;}
+      def S=re[2][iden[iv[1]][i][1]];
+      setring S;
+      if(!defined(EList))
+      {
+        i++;
+        setring R;
+        continue;
+      }
+      setring R;
+      kill ituple,jtuple,ktuple;
+      intvec ituple=iden[iv[1]][i];
+      intvec jtuple=findInIVList(1,ituple[1],iden[iv[2]]);
+      intvec ktuple=findInIVList(1,ituple[1],iden[iv[3]]);
+      if((size(jtuple)!=1)&&(size(ktuple)!=1))
+      {
+//--- chList contains all information about the common charts,
+//--- each entry represents a chart and contains three intvecs from iden
+//--- one for each E_l
+        kill tmpList;
+        list tmpList=ituple,jtuple,ktuple;
+        chList[size(chList)+1]=tmpList;
+        i++;
+        if(i<=size(iden[iv[1]]))
+        {
+           continue;
+        }
+        else
+        {
+           break;
+        }
+      }
+   }
+   if(size(chList)==0)
+   {
+//--- no common chart !!!
+     return(int(0));
+   }
+//----------------------------------------------------------------------------
+// Count points in common charts
+//----------------------------------------------------------------------------
+   for(i=1;i<=size(chList);i++)
+   {
+//--- run through all common charts
+      if(defined(S)) { kill S;}
+      def S=re[2][chList[i][1][1]];
+      setring S;
+//--- intersection in this chart
+      if(defined(interId)){kill interId;}
+      if(localCase==1)
+      {
+//--- in this case we need to intersect with \pi^-1(0)
+         ideal interId=EList[chList[i][1][2]]+EList[chList[i][2][2]]
+                                          +EList[chList[i][3][2]]+BO[5];
+      }
+      else
+      {
+         ideal interId=EList[chList[i][1][2]]+EList[chList[i][2][2]]
+                                          +EList[chList[i][3][2]];
+      }
+      interId=std(interId);
+      if(defined(otherId)) {kill otherId;}
+      ideal otherId=1;
+      for(j=1;j<i;j++)
+      {
+//--- run through the previously computed ones
+        if(defined(opath)){kill opath;}
+        def opath=imap(re[2][chList[j][1][1]],path);
+        comPa=1;
+        while(opath[1,comPa]==path[1,comPa])
+        {
+           comPa++;
+           if((comPa>ncols(path))||(comPa>ncols(opath))) break;
+        }
+        comPa=int(leadcoef(path[1,comPa-1]));
+        otherId=otherId+interId;
+        otherId=intersect(otherId,
+                     fetchInTree(re,chList[j][1][1],
+                                 comPa,chList[i][1][1],"interId",iden));
+      }
+      otherId=std(otherId);
+//--- do not count each point more than once
+      interId=sat(interId,otherId)[1];
+      export(interId);
+      if(dim(interId)>0)
+      {
+         ERROR("CountEijk: intersection not zerodimensional");
+      }
+//--- add the remaining number of points to the total point count numPts
+      numPts=numPts+vdim(interId);
+   }
+   return(numPts);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc chiEij(list re, list iden, intvec iv)
+"Internal procedure - no help and no example available
+"
+{
+//!!! Copy of chiEij_local adjusted for non-local case
+//!!! changes must be made in both copies
+
+//--- compute the Euler characteristic of the intersection
+//--- curve of two exceptional hypersurfaces (of dimension 2)
+//--- one of which is allowed to be a component of the strict transform
+//--- using the formula chi(Eij)=2-2g(Eij)
+
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+  int i,j,k,chi,g;
+  intvec ituple,jtuple,inters;
+  def R=basering;
+//----------------------------------------------------------------------------
+// Find a common chart in which they intersect
+//----------------------------------------------------------------------------
+  for(i=1;i<=size(iden[iv[1]]);i++)
+  {
+//--- find a common chart in which they intersect: only for final charts
+     if(defined(S)) {kill S;}
+     def S=re[2][iden[iv[1]][i][1]];
+     setring S;
+     if(!defined(EList))
+     {
+       i++;
+       setring R;
+       continue;
+     }
+     setring R;
+     kill ituple,jtuple;
+     intvec ituple=iden[iv[1]][i];
+     intvec jtuple=findInIVList(1,ituple[1],iden[iv[2]]);
+     if(size(jtuple)==1)
+     {
+       if(i<size(iden[iv[1]]))
+       {
+//--- not in this chart
+         i++;
+         continue;
+       }
+       else
+       {
+         if(size(inters)==1)
+         {
+//--- E_i and E_j do not meet at all
+            return("leer");
+         }
+         else
+         {
+            return(chi);
+         }
+       }
+     }
+//----------------------------------------------------------------------------
+// Run through common charts and compute the Euler characteristic of
+// each component of Eij.
+// As soon as a component has been treated in a chart, it will not be used in
+// any subsequent charts.
+//----------------------------------------------------------------------------
+     if(defined(S)) {kill S;}
+     def S=re[2][ituple[1]];
+     setring S;
+//--- interId: now all components in this chart,
+//---          but we want only new components
+     if(defined(interId)){kill interId;}
+     ideal interId=EList[ituple[2]]+EList[jtuple[2]];
+     interId=std(interId);
+//--- doneId: already considered components
+     if(defined(doneId)){kill doneId;}
+     ideal doneId=1;
+     for(j=2;j<=size(inters);j++)
+     {
+//--- fetch the components which have already been dealt with via fetchInTree
+        if(defined(opath)) {kill opath;}
+        def opath=imap(re[2][inters[j]],path);
+        k=1;
+        while((k<ncols(opath))&&(k<ncols(path)))
+        {
+           if(path[1,k+1]!=opath[1,k+1]) break;
+           k++;
+        }
+        if(defined(comPa)) {kill comPa;}
+        int comPa=int(leadcoef(path[1,k]));
+        if(defined(tempId)){kill tempId;}
+        ideal tempId=fetchInTree(re,inters[j],comPa,
+                                    iden[iv[1]][i][1],"interId",iden);
+        doneId=intersect(doneId,tempId);
+        kill tempId;
+     }
+//--- only consider new components in interId
+     interId=sat(interId,doneId)[1];
+     if(dim(interId)>1)
+     {
+       ERROR("genus_Eij: higher dimensional intersection");
+     }
+     if(dim(interId)>=0)
+     {
+//--- save the index of the current chart for future use
+        export(interId);
+        inters[size(inters)+1]=iden[iv[1]][i][1];
+     }
+     BO[1]=std(BO[1]);
+     if(((dim(interId)<=0)&&(dim(BO[1])>2))||
+        ((dim(interId)<0)&&(dim(BO[1])==2)))
+     {
+       if(i<size(iden[iv[1]]))
+       {
+//--- not in this chart
+         setring R;
+         i++;
+         continue;
+       }
+       else
+       {
+         if(size(inters)==1)
+         {
+//--- E_i and E_j do not meet at all
+            return("leer");
+         }
+         else
+         {
+            return(chi);
+         }
+       }
+     }
+     g=genus(interId);
+
+//--- chi is the Euler characteristic of the (disjoint !!!) union of the
+//--- considered components
+//--- remark: components are disjoint, because the E_i are normal crossing!!!
+
+     chi=chi+(2-2*g);
+  }
+  return(chi);
+}
+//////////////////////////////////////////////////////////////////////////////
+//////////////////////////////////////////////////////////////////////////////
+static
+proc chiEij_local(list re, list iden, intvec iv)
+"Internal procedure - no help and no example available
+"
+{
+//!!! Copy of chiEij adjusted for local case
+//!!! changes must be made in both copies
+
+//--- we have to consider two different cases:
+//--- case1: E_i \cap E_j \cap \pi^-1(0) is a curve
+//---    compute the Euler characteristic of the intersection
+//---    curve of two exceptional hypersurfaces (of dimension 2)
+//---    one of which is allowed to be a component of the strict transform
+//---    using the formula chi(Eij)=2-2g(Eij)
+//--- case2: E_i \cap E_j \cap \pi^-1(0) is a set of points
+//---    count the points
+
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+  int i,j,k,chi,g,points;
+  intvec ituple,jtuple,inters;
+  def R=basering;
+//----------------------------------------------------------------------------
+// Find a common chart in which they intersect
+//----------------------------------------------------------------------------
+  for(i=1;i<=size(iden[iv[1]]);i++)
+  {
+//--- find a common chart in which they intersect: only for final charts
+     if(defined(S)) {kill S;}
+     def S=re[2][iden[iv[1]][i][1]];
+     setring S;
+     if(!defined(EList))
+     {
+       i++;
+       setring R;
+       continue;
+     }
+     setring R;
+     kill ituple,jtuple;
+     intvec ituple=iden[iv[1]][i];
+     intvec jtuple=findInIVList(1,ituple[1],iden[iv[2]]);
+     if(size(jtuple)==1)
+     {
+       if(i<size(iden[iv[1]]))
+       {
+//--- not in this chart
+         i++;
+         continue;
+       }
+       else
+       {
+         if(size(inters)==1)
+         {
+//--- E_i and E_j do not meet at all
+            return("leer");
+         }
+         else
+         {
+            return(chi);
+         }
+       }
+     }
+//----------------------------------------------------------------------------
+// Run through common charts and compute the Euler characteristic of
+// each component of Eij.
+// As soon as a component has been treated in a chart, it will not be used in
+// any subsequent charts.
+//----------------------------------------------------------------------------
+     if(defined(S)) {kill S;}
+     def S=re[2][ituple[1]];
+     setring S;
+//--- interId: now all components in this chart,
+//---          but we want only new components
+     if(defined(interId)){kill interId;}
+     ideal interId=EList[ituple[2]]+EList[jtuple[2]]+BO[5];
+     interId=std(interId);
+//--- doneId: already considered components
+     if(defined(doneId)){kill doneId;}
+     ideal doneId=1;
+     for(j=2;j<=size(inters);j++)
+     {
+//--- fetch the components which have already been dealt with via fetchInTree
+        if(defined(opath)) {kill opath;}
+        def opath=imap(re[2][inters[j]],path);
+        k=1;
+        while((k<ncols(opath))&&(k<ncols(path)))
+        {
+           if(path[1,k+1]!=opath[1,k+1]) break;
+           k++;
+        }
+        if(defined(comPa)) {kill comPa;}
+        int comPa=int(leadcoef(path[1,k]));
+        if(defined(tempId)){kill tempId;}
+        ideal tempId=fetchInTree(re,inters[j],comPa,
+                                    iden[iv[1]][i][1],"interId",iden);
+        doneId=intersect(doneId,tempId);
+        kill tempId;
+     }
+//--- only consider new components in interId
+     interId=sat(interId,doneId)[1];
+     if(dim(interId)>1)
+     {
+       ERROR("genus_Eij: higher dimensional intersection");
+     }
+     if(dim(interId)>=0)
+     {
+//--- save the index of the current chart for future use
+        export(interId);
+        inters[size(inters)+1]=iden[iv[1]][i][1];
+     }
+     BO[1]=std(BO[1]);
+     if(dim(interId)<0)
+     {
+       if(i<size(iden[iv[1]]))
+       {
+//--- not in this chart
+         setring R;
+         i++;
+         continue;
+       }
+       else
+       {
+         if(size(inters)==1)
+         {
+//--- E_i and E_j do not meet at all
+            return("leer");
+         }
+         else
+         {
+            return(chi);
+         }
+       }
+     }
+     if((dim(interId)==0)&&(dim(std(BO[1]))>2))
+     {
+//--- for sets of points the Euler characteristic is just
+//--- the number of points
+//--- fat points are impossible, since everything is smooth and n.c.
+        chi=chi+vdim(interId);
+        points=1;
+     }
+     else
+     {
+        if(points==1)
+        {
+           ERROR("components of intersection do not have same dimension");
+        }
+        g=genus(interId);
+//--- chi is the Euler characteristic of the (disjoint !!!) union of the
+//--- considered components
+//--- remark: components are disjoint, because the E_i are normal crossing!!!
+        chi=chi+(2-2*g);
+     }
+  }
+  return(chi);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc computeChiE(list re, list iden)
+"Internal procedure - no help and no example available
+"
+{
+//--- compute the Euler characteristic of the exceptional hypersurfaces
+//--- (of dimension 2), not considering the components of the strict
+//--- transform
+
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+   int i,j,k,m,thisE,otherE;
+   def R=basering;
+   intvec nulliv,chi_temp,kvec;
+   nulliv[size(iden)]=0;
+   list chi_E;
+   for(i=1;i<=size(iden);i++)
+   {
+      chi_E[i]=list();
+   }
+//---------------------------------------------------------------------------
+// Run through the list of charts and compute the Euler characteristic of
+// the new exceptional hypersurface and change the values for the old ones
+// according to the blow-up which has just been performed
+// For initialization reasons, treat the case of the first blow-up separately
+//---------------------------------------------------------------------------
+   for(i=2;i<=size(re[2]);i++)
+   {
+//--- run through all charts
+      if(defined(S)){kill S;}
+      def S=re[2][i];
+      setring S;
+      m=int(leadcoef(path[1,ncols(path)]));
+      if(defined(Spa)){kill Spa;}
+      def Spa=re[2][m];
+      if(size(BO[4])==1)
+      {
+//--- just one exceptional divisor
+         thisE=1;
+         setring Spa;
+         if(i==2)
+         {
+//--- have not set the initial value of chi(E_1) yet
+           if(dim(std(cent))==0)
+           {
+//--- center was point ==> new except. div. is a P^2
+              list templist=3*vdim(std(BO[1]+cent)),nulliv;
+           }
+           else
+           {
+//--- center was curve ==> new except. div. is curve x P^1
+              list templist=4-4*genus(BO[1]+cent),nulliv;
+           }
+           chi_E[1]=templist;
+           kill templist;
+         }
+         setring S;
+         i++;
+         if(i<size(re[2]))
+         {
+            continue;
+         }
+         else
+         {
+            break;
+         }
+      }
+      for(j=1;j<=size(iden);j++)
+      {
+//--- find out which exceptional divisor has just been born
+        if(inIVList(intvec(i,size(BO[4])),iden[j]))
+        {
+//--- found it
+           thisE=j;
+           break;
+        }
+      }
+//--- now setup new chi and change the previous ones appropriately
+      setring Spa;
+      if(size(chi_E[thisE])==0)
+      {
+//--- have not set the initial value of chi(E_thisE) yet
+        if(dim(std(cent))==0)
+        {
+//--- center was point  ==> new except. div. is a P^2
+           list templist=3*vdim(std(BO[1]+cent)),nulliv;
+        }
+        else
+        {
+//--- center was curve   ==> new except. div. is a C x P^1
+           list templist=4-4*genus(BO[1]+cent),nulliv;
+        }
+        chi_E[thisE]=templist;
+        kill templist;
+      }
+      for(j=1;j<=size(BO[4]);j++)
+      {
+//--- we are in the parent ring ==> thisE is not yet born
+//--- all the other E_i have already been initialized, but the chi
+//--- might change with the current blow-up at cent
+         if(BO[6][j]==1)
+         {
+//--- ignore empty sets
+            j++;
+            if(j<=size(BO[4]))
+            {
+              continue;
+            }
+            else
+            {
+              break;
+            }
+         }
+         for(k=1;k<=size(iden);k++)
+         {
+//--- find global index of BO[4][j]
+            if(inIVList(intvec(m,j),iden[k]))
+            {
+               otherE=k;
+               break;
+            }
+         }
+         if(chi_E[otherE][2][thisE]==1)
+         {
+//--- already considered this one
+            j++;
+            if(j<=size(BO[4]))
+            {
+              continue;
+            }
+            else
+            {
+              break;
+            }
+         }
+//---------------------------------------------------------------------------
+// update chi according to the formula
+// chi(E_k^transf)=chi(E_k) - chi(C \cap E_k) + chi(E_k \cap E_new)
+// for convenience of implementation, we first compute
+//        chi(E_k) - chi(C \cap E_k)
+// and afterwards add the last term chi(E_k \cap E_new)
+//---------------------------------------------------------------------------
+         ideal CinE=std(cent+BO[4][j]+BO[1]);  // this is C \cap E_k
+         if(dim(CinE)==1)
+         {
+//--- center meets E_k in a curve
+            chi_temp[otherE]=chi_E[otherE][1]-(2-2*genus(CinE));
+         }
+         if(dim(CinE)==0)
+         {
+//--- center meets E_k in points
+            chi_temp[otherE]=chi_E[otherE][1]-vdim(std(CinE));
+         }
+         kill CinE;
+         setring S;
+//--- now we are back in the i-th ring in the list
+         ideal CinE=std(BO[4][j]+BO[4][size(BO[4])]+BO[1]);
+                                              // this is E_k \cap E_new
+         if(dim(CinE)==1)
+         {
+//--- if the two divisors meet, they meet in a curve
+            chi_E[otherE][1]=chi_temp[otherE]+(2-2*genus(CinE));
+            chi_E[otherE][2][thisE]=1;         // this blow-up of E_k is done
+         }
+         kill CinE;
+         setring Spa;
+      }
+   }
+   setring R;
+   return(chi_E);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc computeChiE_local(list re, list iden)
+"Internal procedure - no help and no example available
+"
+{
+//--- compute the Euler characteristic of the intersection of the
+//--- exceptional hypersurfaces with \pi^-1(0) which can be of
+//--- dimension 1 or 2 - not considering the components of the strict
+//--- transform
+
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+   int i,j,k,aa,m,n,thisE,otherE;
+   def R=basering;
+   intvec nulliv,chi_temp,kvec,dimEi,endiv;
+   nulliv[size(iden)]=0;
+   dimEi[size(iden)]=0;
+   endiv[size(re[2])]=0;
+   list chi_E;
+   for(i=1;i<=size(iden);i++)
+   {
+      chi_E[i]=list();
+   }
+//---------------------------------------------------------------------------
+// Run through the list of charts and compute the Euler characteristic of
+// the new exceptional hypersurface and change the values for the old ones
+// according to the blow-up which has just been performed
+// For initialization reasons, treat the case of the first blow-up separately
+//---------------------------------------------------------------------------
+   for(i=2;i<=size(re[2]);i++)
+   {
+//--- run through all charts
+      if(defined(S)){kill S;}
+      def S=re[2][i];
+      setring S;
+      if(defined(EList))
+      {
+         endiv[i]=1;
+      }
+      m=int(leadcoef(path[1,ncols(path)]));
+      if(defined(Spa)){kill Spa;}
+      def Spa=re[2][m];
+      if(size(BO[4])==1)
+      {
+//--- just one exceptional divisor
+         thisE=1;
+         setring Spa;
+         if(i==2)
+         {
+//--- have not set the initial value of chi(E_1) yet
+//--- in the local case, we need to know whether the center contains 0
+           if(size(reduce(cent,std(maxideal(1))))!=0)
+           {
+//--- first center does not meet 0
+              list templist=0,nulliv;
+              dimEi[1]=-1;
+           }
+           else
+           {
+              if(dim(std(cent))==0)
+              {
+//--- center was point ==> new except. div. is a P^2
+                 list templist=3*vdim(std(BO[1]+cent)),nulliv;
+                 dimEi[1]=2;
+              }
+              else
+              {
+//--- center was curve ==> intersection of new exceptional divisor
+//---                      with \pi^-1(0) is a curve, namely P^1
+                 setring S;
+                 list templist=2,nulliv;
+                 dimEi[1]=1;
+              }
+           }
+           chi_E[1]=templist;
+           kill templist;
+         }
+         setring S;
+         i++;
+         if(i<size(re[2]))
+         {
+            continue;
+         }
+         else
+         {
+            break;
+         }
+      }
+      for(j=1;j<=size(iden);j++)
+      {
+//--- find out which exceptional divisor has just been born
+        if(inIVList(intvec(i,size(BO[4])),iden[j]))
+        {
+//--- found it
+           thisE=j;
+           break;
+        }
+      }
+//--- now setup new chi and change the previous ones appropriately
+      setring Spa;
+      if(size(chi_E[thisE])==0)
+      {
+//--- have not set the initial value of chi(E_thisE) yet
+        if(deg(std(cent+BO[5])[1])==0)
+        {
+           if(dim(std(cent))==0)
+           {
+//--- \pi^-1(0) does not meet the Q-point cent
+              list templist=0,nulliv;
+              dimEi[thisE]=-1;
+           }
+//--- if cent is a curve, the intersection point might simply be outside
+//--- of this chart!!!
+        }
+        else
+        {
+           if(dim(std(cent))==0)
+           {
+//--- center was point  ==> new except. div. is a P^2
+              list templist=3*vdim(std(BO[1]+cent)),nulliv;
+              dimEi[thisE]=2;
+           }
+           else
+           {
+//--- center was curve   ==> new except. div. is a C x P^1
+              if(dim(std(cent+BO[5]))==1)
+              {
+//--- whole curve is in \pi^-1(0)
+                 list templist=4-4*genus(BO[1]+cent),nulliv;
+                 dimEi[thisE]=2;
+              }
+              else
+              {
+//--- curve meets \pi^-1(0) in points
+//--- in S, the intersection will be a curve!!!
+                 setring S;
+                 list templist=2-2*genus(BO[1]+BO[4][size(BO[4])]+BO[5]),nulliv;
+                 dimEi[thisE]=1;
+                 setring Spa;
+              }
+           }
+        }
+        if(defined(templist))
+        {
+          chi_E[thisE]=templist;
+        }
+        kill templist;
+      }
+      for(j=1;j<=size(BO[4]);j++)
+      {
+//--- we are in the parent ring ==> thisE is not yet born
+//--- all the other E_i have already been initialized, but the chi
+//--- might change with the current blow-up at cent
+         if(BO[6][j]==1)
+         {
+//--- ignore empty sets
+            j++;
+            if(j<=size(BO[4]))
+            {
+              continue;
+            }
+            else
+            {
+              break;
+            }
+         }
+         for(k=1;k<=size(iden);k++)
+         {
+//--- find global index of BO[4][j]
+            if(inIVList(intvec(m,j),iden[k]))
+            {
+               otherE=k;
+               break;
+            }
+         }
+         if(dimEi[otherE]<=1)
+         {
+//--- dimEi[otherE]==-1: center leading to this E does not meet \pi^-1(0)
+//--- dimEi[otherE]== 0: center leading to this E does not meet \pi^-1(0)
+//---                   in any previously visited charts
+//---                   maybe in some other branch later, but has nothing
+//---                   to do with this center
+//--- dimEi[otherE]== 1: E \cap \pi^-1(0) is curve
+//---                   ==> chi is birational invariant
+            j++;
+            if(j<=size(BO[4]))
+            {
+              continue;
+            }
+            break;
+         }
+         if(chi_E[otherE][2][thisE]==1)
+         {
+//--- already considered this one
+            j++;
+            if(j<=size(BO[4]))
+            {
+              continue;
+            }
+            else
+            {
+              break;
+            }
+         }
+//---------------------------------------------------------------------------
+// update chi according to the formula
+// chi(E_k^transf)=chi(E_k) - chi(C \cap E_k) + chi(E_k \cap E_new)
+// for convenience of implementation, we first compute
+//        chi(E_k) - chi(C \cap E_k)
+// and afterwards add the last term chi(E_k \cap E_new)
+//---------------------------------------------------------------------------
+         ideal CinE=std(cent+BO[4][j]+BO[1]);  // this is C \cap E_k
+         if(dim(CinE)==1)
+         {
+//--- center meets E_k in a curve
+            chi_temp[otherE]=chi_E[otherE][1]-(2-2*genus(CinE));
+         }
+         if(dim(CinE)==0)
+         {
+//--- center meets E_k in points
+            chi_temp[otherE]=chi_E[otherE][1]-vdim(std(CinE));
+         }
+         kill CinE;
+         setring S;
+//--- now we are back in the i-th ring in the list
+         ideal CinE=std(BO[4][j]+BO[4][size(BO[4])]+BO[1]);
+                                              // this is E_k \cap E_new
+         if(dim(CinE)==1)
+         {
+//--- if the two divisors meet, they meet in a curve
+            chi_E[otherE][1]=chi_temp[otherE]+(2-2*genus(CinE));
+            chi_E[otherE][2][thisE]=1;         // this blow-up of E_k is done
+         }
+         kill CinE;
+         setring Spa;
+      }
+   }
+//--- we still need to clean-up the 1-dimensional E_i \cap \pi^-1(0)
+   for(i=1;i<=size(dimEi);i++)
+   {
+      if(dimEi[i]!=1)
+      {
+//--- not 1-dimensional ==> skip
+         i++;
+         if(i>size(dimEi)) break;
+         continue;
+      }
+      if(defined(myCharts)) {kill myCharts;}
+      intvec myCharts;
+      chi_E[i]=0;
+      for(j=1;j<=size(re[2]);j++)
+      {
+         if(endiv[j]==0)
+         {
+//--- not an endChart ==> skip
+            j++;
+            if(j>size(re[2])) break;
+            continue;
+         }
+         if(defined(mtuple)) {kill mtuple;}
+         intvec mtuple=findInIVList(1,j,iden[i]);
+         if(size(mtuple)==1)
+         {
+//-- nothing to do with this Ei ==> skip
+            j++;
+            if(j>size(re[2])) break;
+            continue;
+         }
+         myCharts[size(myCharts)+1]=j;
+         if(defined(S)){kill S;}
+         def S=re[2][j];
+         setring S;
+         if(defined(interId)){kill interId;}
+//--- all components
+         ideal interId=std(BO[4][mtuple[2]]+BO[5]);
+         if(defined(myPts)){kill myPts;}
+         ideal myPts=1;
+         export(myPts);
+         export(interId);
+         if(defined(doneId)){kill doneId;}
+         if(defined(donePts)){kill donePts;}
+         ideal donePts=1;
+         ideal doneId=1;
+         for(k=2;k<size(myCharts);k++)
+         {
+//--- fetch the components which have already been dealt with via fetchInTree
+            if(defined(opath)) {kill opath;}
+            def opath=imap(re[2][myCharts[k][1]],path);
+            aa=1;
+            while((aa<ncols(opath))&&(aa<ncols(path)))
+            {
+               if(path[1,aa+1]!=opath[1,aa+1]) break;
+               aa++;
+            }
+            if(defined(comPa)) {kill comPa;}
+            int comPa=int(leadcoef(path[1,aa]));
+            if(defined(tempId)){kill tempId;}
+            ideal tempId=fetchInTree(re,myCharts[k][1],comPa,j,"interId",iden);
+            doneId=intersect(doneId,tempId);
+            kill tempId;
+            ideal tempId=fetchInTree(re,myCharts[k][1],comPa,j,"myPts",iden);
+            donePts=intersect(donePts,tempId);
+            kill tempId;
+         }
+//--- drop components which have already been dealt with
+         interId=sat(interId,doneId)[1];
+         list pr=minAssGTZ(interId);
+         myPts=std(interId+doneId);
+         for(k=1;k<=size(pr);k++)
+         {
+           for(n=k+1;n<=size(pr);n++)
+           {
+              myPts=intersect(myPts,std(pr[k]+pr[n]));
+           }
+           if(deg(std(pr[k])[1])>0)
+           {
+              chi_E[i]=chi_E[i]+(2-2*genus(pr[k]));
+           }
+         }
+         myPts=sat(myPts,donePts)[1];
+         chi_E[i]=chi_E[i]-vdim(myPts);
+      }
+   }
+   setring R;
+   return(chi_E);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc chi_ast(list re,list iden,list #)
+"Internal procedure - no help and no example available
+"
+{
+//--- compute the Euler characteristic of the Ei,Eij,Eijk and the
+//--- corresponding Ei^*,Eij^*,Eijk^* by preparing the input to the
+//--- specialized auxilliary procedures and then recombining the results
+
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+   int i,j,k,g;
+   intvec tiv;
+   list chi_ijk,chi_ij,chi_i,ast_ijk,ast_ij,ast_i,tmplist,g_ij,emptylist;
+   list leererSchnitt;
+   def R=basering;
+   ring Rhelp=0,@t,dp;
+   setring R;
+//----------------------------------------------------------------------------
+// first compute the chi(Eij) and  at the same time
+// check whether E_i \cap E_j is empty
+// the formula is
+//              chi_ij=2-2*genus(E_i \cap E_j)
+//----------------------------------------------------------------------------
+   if(size(#)>0)
+   {
+      "Entering chi_ast";
+   }
+   for(i=1;i<=size(iden)-1;i++)
+   {
+      for(j=i+1;j<=size(iden);j++)
+      {
+         if(defined(blub)){kill blub;}
+         def blub=chiEij(re,iden,intvec(i,j));
+         if(typeof(blub)=="int")
+         {
+            tmplist=intvec(i,j),blub;
+         }
+         else
+         {
+            leererSchnitt[size(leererSchnitt)+1]=intvec(i,j);
+            tmplist=intvec(i,j),0;
+         }
+         chi_ij[size(chi_ij)+1]=tmplist;
+      }
+   }
+   if(size(#)>0)
+   {
+      "chi_ij computed";
+   }
+//-----------------------------------------------------------------------------
+// compute chi(Eijk)=chi^*(Eijk) by counting the points in the intersection
+//      chi_ijk=#(E_i \cap E_j \cap E_k)
+//      ast_ijk=chi_ijk
+//-----------------------------------------------------------------------------
+   for(i=1;i<=size(iden)-2;i++)
+   {
+      for(j=i+1;j<=size(iden)-1;j++)
+      {
+         for(k=j+1;k<=size(iden);k++)
+         {
+            if(inIVList(intvec(i,j),leererSchnitt))
+            {
+               tmplist=intvec(i,j,k),0;
+            }
+            else
+            {
+               tmplist=intvec(i,j,k),countEijk(re,iden,intvec(i,j,k));
+            }
+            chi_ijk[size(chi_ijk)+1]=tmplist;
+         }
+      }
+   }
+   ast_ijk=chi_ijk;
+   if(size(#)>0)
+   {
+      "chi_ijk computed";
+   }
+//----------------------------------------------------------------------------
+// construct chi(Eij^*) by the formula
+//      ast_ij=chi_ij - sum_ijk chi_ijk,
+// where k runs over all indices != i,j
+//----------------------------------------------------------------------------
+   for(i=1;i<=size(chi_ij);i++)
+   {
+      ast_ij[i]=chi_ij[i];
+      for(k=1;k<=size(chi_ijk);k++)
+      {
+         if(((chi_ijk[k][1][1]==chi_ij[i][1][1])||
+                 (chi_ijk[k][1][2]==chi_ij[i][1][1]))&&
+            ((chi_ijk[k][1][2]==chi_ij[i][1][2])||
+                 (chi_ijk[k][1][3]==chi_ij[i][1][2])))
+         {
+            ast_ij[i][2]=ast_ij[i][2]-chi_ijk[k][2];
+         }
+      }
+   }
+   if(size(#)>0)
+   {
+      "ast_ij computed";
+   }
+//----------------------------------------------------------------------------
+// construct ast_i according to the following formulae
+//      ast_i=0 if E_i is (Q- resp. C-)component of the strict transform
+//      chi_i=3*n if E_i originates from blowing up a Q-point,
+//                which consists of n (different) C-points
+//      chi_i=2-2g(C) if E_i originates from blowing up a (Q-)curve C
+//           (chi_i=n*(2-2g(C_i))=2-2g(C),
+//                 where C=\cup C_i, C_i \cap C_j = \emptyset)
+// if E_i is not a component of the strict transform, then
+//       ast_i=chi_i - sum_{j!=i} ast_ij
+//----------------------------------------------------------------------------
+   for(i=1;i<=size(iden);i++)
+   {
+      if(defined(S)) {kill S;}
+      def S=re[2][iden[i][1][1]];
+      setring S;
+      if(iden[i][1][2]>size(BO[4]))
+      {
+         i--;
+         break;
+      }
+   }
+   list idenE=iden;
+   while(size(idenE)>i)
+   {
+      idenE=delete(idenE,size(idenE));
+   }
+   list cl=computeChiE(re,idenE);
+   for(i=1;i<=size(idenE);i++)
+   {
+      chi_i[i]=list(intvec(i),cl[i][1]);
+   }
+   if(size(#)>0)
+   {
+      "chi_i computed";
+   }
+   for(i=1;i<=size(idenE);i++)
+   {
+      ast_i[i]=chi_i[i];
+      for(j=1;j<=size(ast_ij);j++)
+      {
+         if((ast_ij[j][1][1]==i)||(ast_ij[j][1][2]==i))
+         {
+            ast_i[i][2]=ast_i[i][2]-chi_ij[j][2];
+         }
+      }
+      for(j=1;j<=size(ast_ijk);j++)
+      {
+         if((ast_ijk[j][1][1]==i)||(ast_ijk[j][1][2]==i)
+                                 ||(ast_ijk[j][1][3]==i))
+         {
+            ast_i[i][2]=ast_i[i][2]+chi_ijk[j][2];
+         }
+      }
+   }
+   for(i=size(idenE)+1;i<=size(iden);i++)
+   {
+      ast_i[i]=list(intvec(i),0);
+   }
+//--- results are in ast_i, ast_ij and ast_ijk
+//--- all are of the form intvec(indices),int(value)
+   list result=ast_i,ast_ij,ast_ijk;
+   return(result);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc chi_ast_local(list re,list iden,list #)
+"Internal procedure - no help and no example available
+"
+{
+//--- compute the Euler characteristic of the Ei,Eij,Eijk and the
+//--- corresponding Ei^*,Eij^*,Eijk^* by preparing the input to the
+//--- specialized auxilliary procedures and then recombining the results
+
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+   int i,j,k,g;
+   intvec tiv;
+   list chi_ijk,chi_ij,chi_i,ast_ijk,ast_ij,ast_i,tmplist,g_ij,emptylist;
+   list leererSchnitt;
+   def R=basering;
+   ring Rhelp=0,@t,dp;
+   setring R;
+//----------------------------------------------------------------------------
+// first compute
+// if E_i \cap E_j \cap \pi^-1(0) is a curve:
+//    chi(Eij) and  at the same time
+//    check whether E_i \cap E_j is empty
+//    the formula is
+//              chi_ij=2-2*genus(E_i \cap E_j)
+// otherwise (points):
+//    chi(E_ij) by counting the points
+//----------------------------------------------------------------------------
+   if(size(#)>0)
+   {
+      "Entering chi_ast_local";
+   }
+   for(i=1;i<=size(iden)-1;i++)
+   {
+      for(j=i+1;j<=size(iden);j++)
+      {
+         if(defined(blub)){kill blub;}
+         def blub=chiEij_local(re,iden,intvec(i,j));
+         if(typeof(blub)=="int")
+         {
+            tmplist=intvec(i,j),blub;
+         }
+         else
+         {
+            leererSchnitt[size(leererSchnitt)+1]=intvec(i,j);
+            tmplist=intvec(i,j),0;
+         }
+         chi_ij[size(chi_ij)+1]=tmplist;
+      }
+   }
+   if(size(#)>0)
+   {
+      "chi_ij computed";
+   }
+//-----------------------------------------------------------------------------
+// compute chi(Eijk)=chi^*(Eijk) by counting the points in the intersection
+//      chi_ijk=#(E_i \cap E_j \cap E_k \cap \pi^-1(0))
+//      ast_ijk=chi_ijk
+//-----------------------------------------------------------------------------
+   for(i=1;i<=size(iden)-2;i++)
+   {
+      for(j=i+1;j<=size(iden)-1;j++)
+      {
+         for(k=j+1;k<=size(iden);k++)
+         {
+            if(inIVList(intvec(i,j),leererSchnitt))
+            {
+               tmplist=intvec(i,j,k),0;
+            }
+            else
+            {
+               tmplist=intvec(i,j,k),countEijk(re,iden,intvec(i,j,k),"local");
+            }
+            chi_ijk[size(chi_ijk)+1]=tmplist;
+         }
+      }
+   }
+   ast_ijk=chi_ijk;
+   if(size(#)>0)
+   {
+      "chi_ijk computed";
+   }
+//----------------------------------------------------------------------------
+// construct chi(Eij^*) by the formula
+//      ast_ij=chi_ij - sum_ijk chi_ijk,
+// where k runs over all indices != i,j
+//----------------------------------------------------------------------------
+   for(i=1;i<=size(chi_ij);i++)
+   {
+      ast_ij[i]=chi_ij[i];
+      for(k=1;k<=size(chi_ijk);k++)
+      {
+         if(((chi_ijk[k][1][1]==chi_ij[i][1][1])||
+                 (chi_ijk[k][1][2]==chi_ij[i][1][1]))&&
+            ((chi_ijk[k][1][2]==chi_ij[i][1][2])||
+                 (chi_ijk[k][1][3]==chi_ij[i][1][2])))
+         {
+            ast_ij[i][2]=ast_ij[i][2]-chi_ijk[k][2];
+         }
+      }
+   }
+   if(size(#)>0)
+   {
+      "ast_ij computed";
+   }
+//----------------------------------------------------------------------------
+// construct ast_i according to the following formulae
+//      ast_i=0 if E_i is (Q- resp. C-)component of the strict transform
+// if E_i \cap \pi^-1(0) is of dimension 2:
+//      chi_i=3*n if E_i originates from blowing up a Q-point,
+//                which consists of n (different) C-points
+//      chi_i=2-2g(C) if E_i originates from blowing up a (Q-)curve C
+//           (chi_i=n*(2-2g(C_i))=2-2g(C),
+//                 where C=\cup C_i, C_i \cap C_j = \emptyset)
+// if E_i \cap \pi^-1(0) is a curve:
+//      use the formula chi_i=2-2*genus(E_i \cap \pi^-1(0))
+//
+// for E_i not a component of the strict transform we have
+//       ast_i=chi_i - sum_{j!=i} ast_ij
+//----------------------------------------------------------------------------
+   for(i=1;i<=size(iden);i++)
+   {
+      if(defined(S)) {kill S;}
+      def S=re[2][iden[i][1][1]];
+      setring S;
+      if(iden[i][1][2]>size(BO[4]))
+      {
+         i--;
+         break;
+      }
+   }
+   list idenE=iden;
+   while(size(idenE)>i)
+   {
+      idenE=delete(idenE,size(idenE));
+   }
+   list cl=computeChiE_local(re,idenE);
+   for(i=1;i<=size(idenE);i++)
+   {
+      chi_i[i]=list(intvec(i),cl[i][1]);
+   }
+   if(size(#)>0)
+   {
+      "chi_i computed";
+   }
+   for(i=1;i<=size(idenE);i++)
+   {
+      ast_i[i]=chi_i[i];
+      for(j=1;j<=size(ast_ij);j++)
+      {
+         if((ast_ij[j][1][1]==i)||(ast_ij[j][1][2]==i))
+         {
+            ast_i[i][2]=ast_i[i][2]-chi_ij[j][2];
+         }
+      }
+      for(j=1;j<=size(ast_ijk);j++)
+      {
+         if((ast_ijk[j][1][1]==i)||(ast_ijk[j][1][2]==i)
+                                 ||(ast_ijk[j][1][3]==i))
+         {
+            ast_i[i][2]=ast_i[i][2]+chi_ijk[j][2];
+         }
+      }
+   }
+   for(i=size(idenE)+1;i<=size(iden);i++)
+   {
+      ast_i[i]=list(intvec(i),0);
+   }
+//--- results are in ast_i, ast_ij and ast_ijk
+//--- all are of the form intvec(indices),int(value)
+//"End of chi_ast_local";
+//~;
+   list result=ast_i,ast_ij,ast_ijk;
+   return(result);
+}
+//////////////////////////////////////////////////////////////////////////////
+
+proc zetaDL(list re,int d,list #)
+"USAGE:   zetaDL(L,d[,s][,a]);
+@*        L = list of rings
+@*        d = integer
+@*        s = string
+@*        a = integer
+ASSUME:   L is the output of resolution of singularities
+COMPUTE:  local Denef-Loeser zeta function, if string s is present and
+          has the value 'lokal'; global Denef-Loeser zeta function otherwise
+RETURN:   string specifying the Denef-Loeser zeta function if a not present
+          list l if a is present, where
+          l[1]: string specifying the Denef-Loeser zeta function
+          l[2]: list ast,
+                     ast[1]=chi(Ei^*)
+                     ast[2]=chi(Eij^*)
+                     ast[3]=chi(Eijk^*)
+          l[3]: intvec nu of multiplicites as needed in computation of zeta
+                function
+          l[4]: intvec N of multiplicities as needed in compuation of zeta
+                function
+EXAMPLE:  example zetaDL;   shows an example
+"
+{
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+   def R=basering;
+   int show_all,i;
+   if(size(#)>0)
+   {
+     if((typeof(#[1])=="int")||(size(#)>1))
+     {
+       show_all=1;
+     }
+     if(typeof(#[1])=="string")
+     {
+       if((#[1]=="local")||(#[1]=="lokal"))
+       {
+//          ERROR("Local case not implemented yet");
+          "Local Case: Assuming that no (!) charts were dropped";
+          "during calculation of the resolution (option \"A\")";
+          int localComp=1;
+       }
+       else
+       {
+          "Computing global zeta function";
+       }
+     }
+   }
+//----------------------------------------------------------------------------
+// Identify the embedded divisors and chi(Ei^*), chi(Eij^*) and chi(Eijk^*)
+// as well as the integer vector V(=nu) and N
+//----------------------------------------------------------------------------
+   list iden=prepEmbDiv(re);       //--- identify the E_i
+//!!! TIMING:    E8 takes 520 sec ==> needs speed up
+   if(!defined(localComp))
+   {
+      list ast_list=chi_ast(re,iden); //--- compute chi(E^*)
+   }
+   else
+   {
+      list ast_list=chi_ast_local(re,iden);
+   }
+   intvec Vvec=computeV(re,iden);  //--- nu
+   intvec Nvec=computeN(re,iden);  //--- N
+//----------------------------------------------------------------------------
+// Build a new ring with one parameter s
+// and compute Zeta_top^(d) in its ground field
+//----------------------------------------------------------------------------
+   ring Qs=(0,s),x,dp;
+   number zetaTop=0;
+   number enum,denom;
+   denom=1;
+   for(i=1;i<=size(Nvec);i++)
+   {
+      denom=denom*(Vvec[i]+s*Nvec[i]);
+   }
+//--- factors for which index set J consists of one element
+//--- (do something only if d divides N_j)
+   for(i=1;i<=size(ast_list[1]);i++)
+   {
+      if((((Nvec[ast_list[1][i][1][1]]/d)*d)-Nvec[ast_list[1][i][1][1]]==0)&&
+         (ast_list[1][i][2]!=0))
+      {
+          enum=enum+ast_list[1][i][2]*(denom/(Vvec[ast_list[1][i][1][1]]+s*Nvec[ast_list[1][i][1][1]]));
+      }
+   }
+//--- factors for which index set J consists of two elements
+//--- (do something only if d divides both N_i and N_j)
+//!!! TIMING: E8 takes 690 sec and has 703 elements
+//!!!         ==> need to implement a smarter way to do this
+//!!! e.g. build up enumerator and denominator separately, thus not
+//!!!      searching for common factors in each step
+   for(i=1;i<=size(ast_list[2]);i++)
+   {
+      if((((Nvec[ast_list[2][i][1][1]]/d)*d)-Nvec[ast_list[2][i][1][1]]==0)&&
+         (((Nvec[ast_list[2][i][1][2]]/d)*d)-Nvec[ast_list[2][i][1][2]]==0)&&
+          (ast_list[2][i][2]!=0))
+      {
+         enum=enum+ast_list[2][i][2]*(denom/((Vvec[ast_list[2][i][1][1]]+s*Nvec[ast_list[2][i][1][1]])*(Vvec[ast_list[2][i][1][2]]+s*Nvec[ast_list[2][i][1][2]])));
+      }
+   }
+//--- factors for which index set J consists of three elements
+//--- (do something only if d divides N_i, N_j and N_k)
+//!!! TIMING: E8 takes 490 sec and has 8436 elements
+//!!!         ==> same kind of improvements as in the previous case needed
+   for(i=1;i<=size(ast_list[3]);i++)
+   {
+      if((((Nvec[ast_list[3][i][1][1]]/d)*d)-Nvec[ast_list[3][i][1][1]]==0)&&
+         (((Nvec[ast_list[3][i][1][2]]/d)*d)-Nvec[ast_list[3][i][1][2]]==0)&&
+         (((Nvec[ast_list[3][i][1][3]]/d)*d)-Nvec[ast_list[3][i][1][3]]==0)&&
+         (ast_list[3][i][2]!=0))
+      {
+         enum=enum+ast_list[3][i][2]*(denom/((Vvec[ast_list[3][i][1][1]]+s*Nvec[ast_list[3][i][1][1]])*(Vvec[ast_list[3][i][1][2]]+s*Nvec[ast_list[3][i][1][2]])*(Vvec[ast_list[3][i][1][3]]+s*Nvec[ast_list[3][i][1][3]])));
+      }
+   }
+   zetaTop=enum/denom;
+   zetaTop=numerator(zetaTop)/denominator(zetaTop);
+   string zetaStr=string(zetaTop);
+
+   if(show_all)
+   {
+      list result=zetaStr,ast_list,Vvec,Nvec;
+   }
+   else
+   {
+      list result=zetaStr;
+   }
+   setring R;
+   return(result);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y,z),dp;
+   ideal I=x2+y2+z3;
+   list re=resolve(I,"K");
+   zetaDL(re,1);
+   I=(xz+y2)*(xz+y2+x2)+z5;
+   list L=resolve(I,"K");
+   zetaDL(L,1);
+
+//===== expected zeta function =========
+// (130s+20s^2+87)/(1+s)/(3+4s)/(29+40s)
+//======================================
+}
+//////////////////////////////////////////////////////////////////////////////
+
+proc abstractR(list re)
+"USAGE:   abstractR(L);
+@*        L = list of rings
+ASSUME:   L is output of resolution of singularities
+NOTE:     currently only implemented for isolated surface singularities
+RETURN:   list l
+          l[1]: intvec, where
+                   l[1][i]=1 if the corresponding ring is a final chart
+                             of non-embedded resolution
+                   l[1][i]=0 otherwise
+          l[2]: intvec, where
+                   l[2][i]=1 if the corresponding ring does not occur
+                             in the non-embedded resolution
+                   l[2][i]=0 otherwise
+          l[3]: list L
+EXAMPLE:  example abstractR;   shows an example
+"
+{
+//---------------------------------------------------------------------------
+// Initialization and sanity checks
+//---------------------------------------------------------------------------
+   def R=basering;
+//---Test whether we are in the irreducible surface case
+   def S=re[2][1];
+   setring S;
+   BO[2]=BO[2]+BO[1];
+   if(dim(std(BO[2]))!=2)
+   {
+       ERROR("NOT A SURFACE");
+   }
+   if(dim(std(slocus(BO[2])))>0)
+   {
+       ERROR("NOT AN ISOLATED SINGULARITY");
+   }
+   setring R;
+   int i,j,k,l,i0;
+   intvec deleted;
+   intvec endiv;
+   endiv[size(re[2])]=0;
+   deleted[size(re[2])]=0;
+//-----------------------------------------------------------------------------
+// run through all rings, only consider final charts
+// for each final chart follow the list of charts leading up to it until
+//     we encounter a chart which is not finished in the non-embedded case
+//-----------------------------------------------------------------------------
+   for(i=1;i<=size(re[2]);i++)
+   {
+      if(defined(S)){kill S;}
+      def S=re[2][i];
+      setring S;
+      if(size(reduce(cent,std(BO[2]+BO[1])))!=0)
+      {
+//--- only consider endrings
+         i++;
+         continue;
+      }
+      i0=i;
+      for(j=ncols(path);j>=2;j--)
+      {
+//--- walk backwards through history
+        if(j==2)
+        {
+          endiv[i0]=1;
+          break;
+        }
+        k=int(leadcoef(path[1,j]));
+        if((deleted[k]==1)||(endiv[k]==1))
+        {
+          deleted[i0]=1;
+          break;
+        }
+        if(defined(SPa)){kill SPa;}
+        def SPa=re[2][k];
+        setring SPa;
+        l=int(leadcoef(path[1,ncols(path)]));
+        if(defined(SPa2)){kill SPa2;}
+        def SPa2=re[2][l];
+        setring SPa2;
+        if((deleted[l]==1)||(endiv[l]==1))
+        {
+//--- parent was already treated via different final chart
+//--- we may safely inherit the data
+          deleted[i0]=1;
+          setring S;
+          i0=k;
+          j--;
+          continue;
+        }
+        setring SPa;
+//!!! Idea of Improvement:
+//!!! BESSER: rueckwaerts gehend nur testen ob glatt
+//!!!         danach vorwaerts bis zum ersten Mal abstractNC
+//!!! ACHTUNG: rueckweg unterwegs notieren - wir haben nur vergangenheit!
+        if((deg(std(slocus(BO[2]))[1])!=0)||(!abstractNC(BO)))
+        {
+//--- not finished in the non-embedded case
+           endiv[i0]=1;
+           break;
+        }
+//--- unnecessary chart in non-embedded case
+        setring S;
+        deleted[i0]=1;
+        i0=k;
+      }
+   }
+//-----------------------------------------------------------------------------
+// Clean up the intvec deleted and return the result
+//-----------------------------------------------------------------------------
+   setring R;
+   for(i=1;i<=size(endiv);i++)
+   {
+     if(endiv[i]==1)
+     {
+        if(defined(S)) {kill S;}
+        def S=re[2][i];
+        setring S;
+        for(j=3;j<ncols(path);j++)
+        {
+           if((endiv[int(leadcoef(path[1,j]))]==1)||
+              (deleted[int(leadcoef(path[1,j]))]==1))
+           {
+              deleted[int(leadcoef(path[1,j+1]))]=1;
+              endiv[int(leadcoef(path[1,j+1]))]=0;
+           }
+        }
+        if((endiv[int(leadcoef(path[1,ncols(path)]))]==1)||
+           (deleted[int(leadcoef(path[1,ncols(path)]))]==1))
+        {
+           deleted[i]=1;
+           endiv[i]=0;
+        }
+     }
+   }
+   list resu=endiv,deleted,re;
+   return(resu);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring r = 0,(x,y,z),dp;
+   ideal I=x2+y2+z11;
+   list L=resolve(I);
+   abstractR(L);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc decompE(list BO)
+"Internal procedure - no help and no example available
+"
+{
+//--- compute the list of exceptional divisors, including the components
+//--- of the strict transform in the non-embedded case
+//--- (computation over Q !!!)
+   def R=basering;
+   list Elist,prList;
+   int i;
+   for(i=1;i<=size(BO[4]);i++)
+   {
+      Elist[i]=BO[4][i];
+   }
+/* practical speed up (part 1 of 3) -- no theoretical relevance
+   ideal M=maxideal(1);
+   M[1]=var(nvars(basering));
+   M[nvars(basering)]=var(1);
+   map phi=R,M;
+*/
+   ideal KK=BO[2];
+
+/* practical speed up (part 2 of 3)
+   KK=phi(KK);
+*/
+   prList=minAssGTZ(KK);
+
+/* practical speed up (part 3 of 3)
+   prList=phi(prList);
+*/
+
+   for(i=1;i<=size(prList);i++)
+   {
+      Elist[size(BO[4])+i]=prList[i];
+   }
+   return(Elist);
+}
+//////////////////////////////////////////////////////////////////////////////
+
+proc prepEmbDiv(list re, list #)
+"USAGE:   prepEmbDiv(L[,a]);
+@*        L = list of rings
+@*        a = integer
+ASSUME:   L is output of resolution of singularities
+COMPUTE:  if a is not present: exceptional divisors including components
+          of the strict transform
+          otherwise: only exceptional divisors
+RETURN:   list of Q-irreducible exceptional divisors (embedded case)
+EXAMPLE:  example prepEmbDiv;   shows an example
+"
+{
+//--- 1) in each final chart, a list of (decomposed) exceptional divisors
+//---    is created (and exported)
+//--- 2) the strict transform is decomposed
+//--- 3) the exceptional divisors (including the strict transform)
+//---    in the different charts are compared, identified and this
+//---    information collected into a list which is then returned
+//---------------------------------------------------------------------------
+// Initialization
+//---------------------------------------------------------------------------
+   int i,j,k,ncomps,offset,found,a,b,c,d;
+   list tmpList;
+   def R=basering;
+//--- identify identical exceptional divisors
+//--- (note: we are in the embedded case)
+   list iden=collectDiv(re)[2];
+//---------------------------------------------------------------------------
+// Go to each final chart and create the EList
+//---------------------------------------------------------------------------
+   for(i=1;i<=size(iden[size(iden)]);i++)
+   {
+      if(defined(S)){kill S;}
+      def S=re[2][iden[size(iden)][i][1]];
+      setring S;
+      if(defined(EList)){kill EList;}
+      list EList=decompE(BO);
+      export(EList);
+      setring R;
+      kill S;
+   }
+//--- save original iden for further use and then drop
+//--- strict transform from it
+   list iden0=iden;
+   iden=delete(iden,size(iden));
+   if(size(#)>0)
+   {
+//--- we are not interested in the strict transform of X
+      return(iden);
+   }
+//----------------------------------------------------------------------------
+// Run through all final charts and collect and identify all components of
+// the strict transform
+//----------------------------------------------------------------------------
+//--- first final chart - to be used for initialization
+   def S=re[2][iden0[size(iden0)][1][1]];
+   setring S;
+   ncomps=size(EList)-size(BO[4]);
+   if((ncomps==1)&&(deg(std(EList[size(EList)])[1])==0))
+   {
+      ncomps=0;
+   }
+   offset=size(BO[4]);
+   for(i=1;i<=ncomps;i++)
+   {
+//--- add components of strict transform
+      tmpList[1]=intvec(iden0[size(iden0)][1][1],size(BO[4])+i);
+      iden[size(iden)+1]=tmpList;
+   }
+//--- now run through the other final charts
+   for(i=2;i<=size(iden0[size(iden0)]);i++)
+   {
+      if(defined(S2)){kill S2;}
+      def S2=re[2][iden0[size(iden0)][i][1]];
+      setring S2;
+//--- determine common parent of this ring and re[2][iden0[size(iden0)][1][1]]
+      if(defined(opath)){kill opath;}
+      def opath=imap(S,path);
+      j=1;
+      while(opath[1,j]==path[1,j])
+      {
+         j++;
+         if((j>ncols(path))||(j>ncols(opath))) break;
+      }
+      if(defined(li1)){kill li1;}
+      list li1;
+//--- fetch the components we have considered in
+//--- re[2][iden0[size(iden0)][1][1]]
+//--- via the resolution tree
+      for(k=1;k<=ncomps;k++)
+      {
+         if(defined(id1)){kill id1;}
+         string tempstr="EList["+string(eval(k+offset))+"]";
+         ideal id1=fetchInTree(re,iden0[size(iden0)][1][1],
+                               int(leadcoef(path[1,j-1])),
+                               iden0[size(iden0)][i][1],tempstr,iden0,1);
+         kill tempstr;
+         li1[k]=id1;
+         kill id1;
+      }
+//--- do the comparison
+      for(k=size(BO[4])+1;k<=size(EList);k++)
+      {
+//--- only components of the strict transform are interesting
+         if((size(BO[4])+1==size(EList))&&(deg(std(EList[size(EList)])[1])==0))
+         {
+            break;
+         }
+         found=0;
+         for(j=1;j<=size(li1);j++)
+         {
+            if((size(reduce(li1[j],std(EList[k])))==0)&&
+               (size(reduce(EList[k],std(li1[j])))==0))
+            {
+//--- found a match
+               li1[j]=ideal(1);
+               iden[size(iden0)-1+j][size(iden[size(iden0)-1+j])+1]=
+                      intvec(iden0[size(iden0)][i][1],k);
+               found=1;
+               break;
+            }
+         }
+         if(!found)
+         {
+//--- no match yet, maybe there are entries not corresponding to the
+//--- initialization of the list -- collected in list repair
+            if(!defined(repair))
+            {
+//--- no entries in repair, we add the very first one
+               list repair;
+               repair[1]=list(intvec(iden0[size(iden0)][i][1],k));
+            }
+            else
+            {
+//--- compare against repair, and add the item appropriately
+//--- steps of comparison as before
+               for(c=1;c<=size(repair);c++)
+               {
+                  for(d=1;d<=size(repair[c]);d++)
+                  {
+                     if(defined(opath)) {kill opath;}
+                     def opath=imap(re[2][repair[c][d][1]],path);
+                     b=0;
+                     while(path[1,b+1]==opath[1,b+1])
+                     {
+                        b++;
+                        if((b>ncols(path)-1)||(b>ncols(opath)-1)) break;
+                     }
+                     b=int(leadcoef(path[1,b]));
+                     string tempstr="EList["+string(eval(repair[c][d][2]))
+                                     +"]";
+                     if(defined(id1)){kill id1;}
+                     ideal id1=fetchInTree(re,repair[c][d][1],b,
+                               iden0[size(iden0)][i][1],tempstr,iden0,1);
+                     kill tempstr;
+                     if((size(reduce(EList[k],std(id1)))==0)&&
+                        (size(reduce(id1,std(EList[k])))==0))
+                     {
+                        repair[c][size(repair[c])+1]=intvec(iden0[size(iden0)][i][1],k);
+                        break;
+                     }
+                  }
+                  if(d<=size(repair[c]))
+                  {
+                     break;
+                  }
+               }
+               if(c>size(repair))
+               {
+                  repair[size(repair)+1]=list(intvec(iden0[size(iden0)][i][1],k));
+               }
+            }
+         }
+      }
+   }
+   if(defined(repair))
+   {
+//--- there were further components, add them
+      for(c=1;c<=size(repair);c++)
+      {
+         iden[size(iden)+1]=repair[c];
+      }
+      kill repair;
+   }
+//--- up to now only Q-irred components - not C-irred components !!!
+   return(iden);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y,z),dp;
+   ideal I=x2+y2+z11;
+   list L=resolve(I);
+   prepEmbDiv(L);
+}
+///////////////////////////////////////////////////////////////////////////////
+static
+proc decompEinX(list BO)
+"Internal procedure - no help and no example available
+"
+{
+//--- decomposition of exceptional divisor, non-embedded resolution.
+//--- even a single exceptional divisor may be Q-reducible when considered
+//--- as divisor on the strict transform
+
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+   int i,j,k,de,contact;
+   intmat interMat;
+   list dcE,tmpList,prList,sa,nullList;
+   string mpol,compList;
+   def R=basering;
+   ideal I;
+//----------------------------------------------------------------------------
+// pass to divisors on V(J) and throw away components already present as
+// previous exceptional divisors
+//----------------------------------------------------------------------------
+   for(i=1;i<=size(BO[4]);i++)
+   {
+      I=BO[4][i]+BO[2];
+      for(j=i+1;j<=size(BO[4]);j++)
+      {
+         sa=sat(I,BO[4][j]+BO[2]);
+         if(sa[2])
+         {
+           I=sa[1];
+         }
+      }
+//!!! Practical improvement - not yet implemented:
+//!!!hier den Input besser aufbereiten (cf. J. Wahl's example)
+//!!!I[1]=x(2)^15*y(2)^9+3*x(2)^10*y(2)^6+3*x(2)^5*y(2)^3+x(2)+1;
+//!!!I[2]=x(2)^8*y(2)^6+y(0);
+//!!!heuristisch die Ordnung so waehlen, dass y(0) im Prinzip eliminiert
+//!!!wird.
+//-----------------------------------------------------------------------------
+// 1) decompose exceptional divisor (over Q)
+// 2) check whether there are C-reducible Q-components
+// 3) if necessary, find appropriate field extension of Q to decompose
+// 4) in each chart collect information in list dcE and export it
+//-----------------------------------------------------------------------------
+      prList=primdecGTZ(I);
+      for(j=1;j<=size(prList);j++)
+      {
+        tmpList=grad(prList[j][2]);
+        de=tmpList[1];
+        interMat=tmpList[2];
+        mpol=tmpList[3];
+        compList=tmpList[4];
+        nullList=tmpList[5];
+        contact=Kontakt(prList[j][1],BO[2]);
+        tmpList=prList[j][2],de,contact,interMat,mpol,compList,nullList;
+        prList[j]=tmpList;
+      }
+      dcE[i]=prList;
+   }
+   return(dcE);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc getMinpoly(poly p)
+"Internal procedure - no help and no example available
+"
+{
+//---assume that p is a polynomial in 2 variables and irreducible
+//---over Q. Computes an irreducible polynomial mp in one variable
+//---over Q such that p splits completely over the splitting field of mp
+//---returns mp as a string
+//---use a variant of the algorithm of S. Gao
+  def R=basering;
+  int i,j,k,a,b,m,n;
+  intvec v;
+  string mp="poly p=t-1;";
+  list Li=string(1);
+  list re=mp,Li,1;
+
+//---check which variables occur in p
+  for(i=1;i<=nvars(basering);i++)
+  {
+    if(p!=subst(p,var(i),0)){v[size(v)+1]=i;}
+  }
+
+//---the poly is constant
+  if(size(v)==1){return(re);}
+
+//---the poly depends only on one variable or is homogeneous
+//---in 2 variables
+  if((size(v)==2)||((size(v)==3)&&(homog(p))))
+  {
+     if((size(v)==3)&&(homog(p)))
+     {
+        p=subst(p,var(v[3]),1);
+     }
+     ring Rhelp=0,var(v[2]),dp;
+     poly p=imap(R,p);
+     ring Shelp=0,t,dp;
+     poly p=fetch(Rhelp,p);
+     int de=deg(p);
+     p=simplifyMinpoly(p);
+     Li=getNumZeros(p);
+     short=0;
+     mp="poly p="+string(p)+";";
+     re=mp,Li,de;
+     setring R;
+     return(re);
+  }
+  v=v[2..size(v)];
+  if(size(v)>2){ERROR("getMinpoly:input depends on more then 2 variables");}
+
+//---the general case, the poly is considered as poly in x an y now
+  ring T=0,(x,y),lp;
+  ideal M,N;
+  M[nvars(R)]=0;
+  N[nvars(R)]=0;
+  M[v[1]]=x;
+  N[v[1]]=y;
+  M[v[2]]=y;
+  N[v[2]]=x;
+  map phi=R,M;
+  map psi=R,N;
+  poly p=phi(p);
+  poly q=psi(p);
+  ring Thelp=(0,x),y,dp;
+  poly p=imap(T,p);
+  poly q=imap(T,q);
+  n=deg(p);              //---the degree with respect to y
+  m=deg(q);              //---the degree with respect to x
+  setring T;
+  ring A=0,(u(1..m*(n+1)),v(1..(m+1)*n),x,y,t),dp;
+  poly f=imap(T,p);
+  poly g;
+  poly h;
+  for(i=0;i<=m-1;i++)
+  {
+     for(j=0;j<=n;j++)
+     {
+        g=g+u(i*(n+1)+j+1)*x^i*y^j;
+     }
+  }
+  for(i=0;i<=m;i++)
+  {
+     for(j=0;j<=n-1;j++)
+     {
+        h=h+v(i*n+j+1)*x^i*y^j;
+     }
+  }
+  poly L=f*(diff(g,y)-diff(h,x))+h*diff(f,x)-g*diff(f,y);
+//---according to the theory f is absolutely irreducible iff
+//---L(g,h)=0 has no non-trivial solution g,h
+//---(g=diff(f,x),h=diff(f,y) is always a solution)
+//---therefore we compute a vector space basis of G
+//---G={g in Q[x,y],deg_x(g)<m,|exist h, such that L(g,h)=0}
+//---dim(G)=a is the number of factors of f in C[x,y]
+  matrix M=coef(L,xy);
+  ideal J=M[2,1..ncols(M)];
+  option(redSB);
+  J=std(J);
+  option(noredSB);
+  poly gred=reduce(g,J);
+  ideal G;
+  for(i=1;i<=m*(n+1);i++)
+  {
+    if(gred!=subst(gred,u(i),0))
+    {
+       G[size(G)+1]=subst(gred,u(i),1);
+    }
+  }
+  for(i=1;i<=n*(m+1);i++)
+  {
+    if(gred!=subst(gred,v(i),0))
+    {
+       G[size(G)+1]=subst(gred,v(i),1);
+    }
+  }
+  for(i=1;i<=m*(n+1);i++)
+  {
+     G=subst(G,u(i),0);
+  }
+  for(i=1;i<=n*(m+1);i++)
+  {
+     G=subst(G,v(i),0);
+  }
+//---the number of factors in C[x,y]
+  a=size(G);
+  for(i=1;i<=a;i++)
+  {
+     G[i]=simplify(G[i],1);
+  }
+  if(a==1)
+  {
+//---f is absolutely irreducible
+    setring R;
+    return(re);
+  }
+//---let g in G be any non-trivial element (g not in <diff(f,x)>)
+//---according to the theory f=product over all c in C of the
+//---gcd(f,g-c*diff(f,x))
+//---let g_1,...,g_a be a basis of G and write
+//---g*g_i=sum a_ij*g_j*diff(f,x)  mod f
+//---let B=(a_ij) and ch=det(t*unitmat(a)-B) the characteristic
+//---polynomial then the number of distinct irreducible factors
+//---of gcd(f,g-c*diff(f,x)) in C[x,y] is equal to the multiplicity
+//---of c as a root of ch.
+//---in our special situation (f is irreducible over Q) ch should
+//---be irreducible and the different roots of ch lead to the
+//---factors of f, i.e. ch is the minpoly we are looking for
+
+  poly fh=homog(f,t);
+//---homogenization is used to obtain a constant matrix using lift
+  ideal Gh=homog(G,t);
+  int dh,df;
+  df=deg(fh);
+  for(i=1;i<=a;i++)
+  {
+    if(deg(Gh[i])>dh){dh=deg(Gh[i]);}
+  }
+  for(i=1;i<=a;i++)
+  {
+    Gh[i]=t^(dh-deg(Gh[i]))*Gh[i];
+  }
+  ideal GF=simplify(diff(fh,x),1)*Gh,fh;
+  poly ch;
+  matrix LI;
+  matrix B[a][a];
+  matrix E=unitmat(a);
+  poly gran;
+  ideal fac;
+  for(i=1;i<=a;i++)
+  {
+     LI=lift(GF,t^(df-1-dh)*Gh[i]*Gh);
+     B=LI[1..a,1..a];
+     ch=det(t*E-B);
+//---irreducibility test
+     fac=factorize(ch,1);
+     if(deg(fac[1])==a)
+     {
+        ch=simplifyMinpoly(ch);
+        Li=getNumZeros(ch);
+        int de=deg(ch);
+        short=0;
+        mp="poly p="+string(ch)+";";
+        re=mp,Li,de;
+        setring R;
+        return(re);
+     }
+  }
+  ERROR("getMinpoly:not found:please send the example to the authors");
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc getNumZeros(poly p)
+"Internal procedure - no help and no example available
+"
+{
+//--- compute numerically (!!!) the zeros of the minimal polynomial
+  def R=basering;
+  ring S=0,t,dp;
+  poly p=imap(R,p);
+  def L=laguerre_solve(p,30);
+//!!! practical improvement:
+//!!! testen ob die Nullstellen signifikant verschieden sind
+//!!! und im Notfall Genauigkeit erhoehen
+  list re;
+  int i;
+  for(i=1;i<=size(L);i++)
+  {
+    re[i]=string(L[i]);
+  }
+  setring R;
+  return(re);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc simplifyMinpoly(poly p)
+"Internal procedure - no help and no example available
+"
+{
+//--- describe field extension in a simple way
+   p=cleardenom(p);
+   int n=int(leadcoef(p));
+   int d=deg(p);
+   int i,k;
+   int re=1;
+   number s=1;
+
+   list L=primefactors(n);
+
+   for(i=1;i<=size(L[1]);i++)
+   {
+      k=L[2][i] mod d;
+      s=1/number((L[1][i])^(L[2][i]/d));
+      if(!k){p=subst(p,t,s*t);}
+   }
+   p=cleardenom(p);
+   n=int(leadcoef(subst(p,t,0)));
+   L=primefactors(n);
+   for(i=1;i<=size(L[1]);i++)
+   {
+      k=L[2][i] mod d;
+      s=(L[1][i])^(L[2][i]/d);
+      if(!k){p=subst(p,t,s*t);}
+   }
+   p=cleardenom(p);
+   return(p);
+}
+///////////////////////////////////////////////////////////////////////////////
+static
+proc grad(ideal I)
+"Internal procedure - no help and no example available
+"
+{
+//--- computes the number of components over C
+//--- for a prime ideal of height 1 over Q
+  def R=basering;
+  int n=nvars(basering);
+  string mp="poly p=t-1;";
+  string str=string(1);
+  list zeroList=string(1);
+  int i,j,k,l,d,e,c,mi;
+  ideal Istd=std(I);
+  intmat interMat;
+  d=dim(Istd);
+  if(d==-1){return(list(0,0,mp,str,zeroList));}
+  if(d!=1){ERROR("ideal is not one-dimensional");}
+  ideal Sloc=std(slocus(I));
+  if(deg(Sloc[1])>0)
+  {
+//---This is only to test that in case of singularities we have only
+//---one singular point which is a normal crossing
+//---consider the different singular points
+    ideal M;
+    list pr=minAssGTZ(Sloc);
+    if(size(pr)>1){ERROR("grad:more then one singular point");}
+    for(l=1;l<=size(pr);l++)
+    {
+       M=std(pr[l]);
+       d=vdim(M);
+       if(d!=1)
+       {
+//---now we have to extend the field
+          if(defined(S)){kill S;}
+          ring S=0,x(1..n),lp;
+          ideal M=fetch(R,M);
+          ideal I=fetch(R,I);
+          ideal jmap;
+          map phi=S,maxideal(1);;
+          ideal Mstd=std(M);
+//---M has to be in general position with respect to lp, i.e.
+//---vdim(M)=deg(M[1])
+          poly p=Mstd[1];
+          e=vdim(Mstd);
+          while(e!=deg(p))
+          {
+             jmap=randomLast(100);
+             phi=S,jmap;
+             Mstd=std(phi(M));
+             p=Mstd[1];
+          }
+          I=phi(I);
+          kill phi;
+//---now it is in general position an M[1] defines the field extension
+//---Q[x]/M over Q
+          ring Shelp=0,t,dp;
+          ideal helpmap;
+          helpmap[n]=t;
+          map psi=S,helpmap;
+          poly p=psi(p);
+          ring T=(0,t),x(1..n),lp;
+          poly p=imap(Shelp,p);
+//---we are now in the polynomial ring over the field Q[x]/M
+          minpoly=leadcoef(p);
+          ideal M=imap(S,Mstd);
+          M=M,var(n)-t;
+          ideal I=fetch(S,I);
+       }
+//---we construct a map phi which maps M to maxideal(1)
+       option(redSB);
+       ideal Mstd=-simplify(std(M),1);
+       option(noredSB);
+       for(i=1;i<=n;i++)
+       {
+         Mstd=subst(Mstd,var(i),-var(i));
+         M[n-i+1]=Mstd[i];
+       }
+       M=M[1..n];
+//---go to the localization with respect to <x>
+       if(d!=1)
+       {
+          ring Tloc=(0,t),x(1..n),ds;
+          poly p=imap(Shelp,p);
+          minpoly=leadcoef(p);
+          ideal M=fetch(T,M);
+          map phi=T,M;
+       }
+       else
+       {
+          ring Tloc=0,x(1..n),ds;
+          ideal M=fetch(R,M);
+          map phi=R,M;
+       }
+       ideal I=phi(I);
+       ideal Istd=std(I);
+       mi=mi+milnor(Istd);
+       if(mi>l)
+       {
+          ERROR("grad:divisor is really singular");
+       }
+       setring R;
+    }
+  }
+  intvec ind=indepSet(Istd,1)[1];
+  for(i=1;i<=n;i++){if(ind[i]) break;}
+//---the i-th variable is the independent one
+  ring Shelp=0,x(1..n),dp;
+  ideal I=fetch(R,I);
+  if(defined(S)){kill S;}
+  if(i==1){ring S=(0,x(1)),x(2..n),lp;}
+  if(i==n){ring S=(0,x(n)),x(1..n-1),lp;}
+  if((i!=1)&&(i!=n)){ring S=(0,x(i)),(x(1..i-1),x(i+1..n)),lp;}
+//---I is zero-dimensional now
+  ideal I=imap(Shelp,I);
+  ideal Istd=std(I);
+  ideal jmap;
+  map phi;
+  poly p=Istd[1];
+  e=vdim(Istd);
+  if(e==1)
+  {
+     setring R;
+     str=string(I);
+     list resi=1,interMat,mp,str,zeroList;
+     return(resi);
+  }
+//---move I to general position with respect to lp
+  if(e!=deg(p))
+  {
+     jmap=randomLast(5);
+     phi=S,jmap;
+     Istd=std(phi(I));
+     p=Istd[1];
+  }
+  while(e!=deg(p))
+  {
+     jmap=randomLast(100);
+     phi=S,jmap;
+     Istd=std(phi(I));
+     p=Istd[1];
+  }
+  setring Shelp;
+  poly p=imap(S,p);
+  list Q=getMinpoly(p);
+  int de=Q[3];
+  mp=Q[1];
+//!!!diese Stelle effizienter machen
+//!!!minAssGTZ vermeiden durch direkte Betrachtung von
+//!!!p und mp und evtl. Quotientenbildung
+//!!!bisher nicht zeitkritisch
+  string Tesr="ring Tes=(0,t),("+varstr(R)+"),dp;";
+  execute(Tesr);
+  execute(mp);
+  minpoly=leadcoef(p);
+  ideal I=fetch(R,I);
+  list pr=minAssGTZ(I);
+  ideal allgEbene=randomLast(100)[nvars(basering)];
+  int minpts=vdim(std(I+allgEbene));
+  ideal tempi;
+  j=1;
+  for(i=1;i<=size(pr);i++)
+  {
+    tempi=std(pr[i]+allgEbene);
+    if(vdim(tempi)<minpts)
+    {
+      minpts=vdim(tempi);
+      j=i;
+    }
+  }
+  tempi=pr[j];
+  str=string(tempi);
+  kill interMat;
+  setring R;
+  intmat interMat[de][de]=intersComp(str,mp,Q[2],str,mp,Q[2]);
+  list resi=de,interMat,mp,str,Q[2];
+  return(resi);
+}
+////////////////////////////////////////////////////////////////////////////
+static
+proc Kontakt(ideal I, ideal K)
+"Internal procedure - no help and no example available
+"
+{
+//---Let K be a prime ideal and I an ideal not contained in K
+//---computes a maximalideal M=<x(1)-a1,...,x(n)-an>, ai in a field
+//---extension of Q,  containing I+K and an integer a
+//---such that in the localization of the polynomial ring with
+//---respect to M the ideal I is not contained in K+M^a+1 but in M^a in
+  def R=basering;
+  int n=nvars(basering);
+  int i,j,k,d,e;
+  ideal J=std(I+K);
+  if(dim(J)==-1){return(0);}
+  ideal W;
+//---choice of the maximal ideal M
+  for(i=1;i<=n;i++)
+  {
+     W=std(J,var(i));
+     d=dim(W);
+     if(d==0) break;
+  }
+  i=1;k=2;
+  while((d)&&(i<n))
+  {
+     W=std(J,var(i)+var(k));
+     d=dim(W);
+     if(k==n){i++;k=i;}
+     if(k<n){k++;}
+  }
+  while(d)
+  {
+    W=std(J,randomid(maxideal(1))[1]);
+    d=dim(W);
+  }
+//---now we have a collection om maximalideals and choose one with dim Q[x]/M
+//---minimal
+  list pr=minAssGTZ(W);
+  d=vdim(std(pr[1]));
+  k=1;
+  for(i=2;i<=size(pr);i++)
+  {
+    if(d==1) break;
+    e=vdim(std(pr[i]));
+    if(e<d){k=i;d=e;}
+  }
+//---M is fixed now
+//---if dim Q[x]/M =1 we localize at M
+  ideal M=pr[k];
+  if(d!=1)
+  {
+//---now we have to extend the field
+     if(defined(S)){kill S;}
+     ring S=0,x(1..n),lp;
+     ideal M=fetch(R,M);
+     ideal I=fetch(R,I);
+     ideal K=fetch(R,K);
+     ideal jmap;
+     map phi=S,maxideal(1);;
+     ideal Mstd=std(M);
+//---M has to be in general position with respect to lp, i.e.
+//---vdim(M)=deg(M[1])
+     poly p=Mstd[1];
+     e=vdim(Mstd);
+     while(e!=deg(p))
+     {
+        jmap=randomLast(100);
+        phi=S,jmap;
+        Mstd=std(phi(M));
+        p=Mstd[1];
+     }
+     I=phi(I);
+     K=phi(K);
+     kill phi;
+//---now it is in general position an M[1] defines the field extension
+//---Q[x]/M over Q
+     ring Shelp=0,t,dp;
+     ideal helpmap;
+     helpmap[n]=t;
+     map psi=S,helpmap;
+     poly p=psi(p);
+     ring T=(0,t),x(1..n),lp;
+     poly p=imap(Shelp,p);
+//---we are now in the polynomial ring over the field Q[x]/M
+     minpoly=leadcoef(p);
+     ideal M=imap(S,Mstd);
+     M=M,var(n)-t;
+     ideal I=fetch(S,I);
+     ideal K=fetch(S,K);
+  }
+//---we construct a map phi which maps M to maxideal(1)
+  option(redSB);
+  ideal Mstd=-simplify(std(M),1);
+  option(noredSB);
+  for(i=1;i<=n;i++)
+  {
+    Mstd=subst(Mstd,var(i),-var(i));
+    M[n-i+1]=Mstd[i];
+  }
+  M=M[1..n];
+//---go to the localization with respect to <x>
+  if(d!=1)
+  {
+     ring Tloc=(0,t),x(1..n),ds;
+     poly p=imap(Shelp,p);
+     minpoly=leadcoef(p);
+     ideal M=fetch(T,M);
+     map phi=T,M;
+  }
+  else
+  {
+     ring Tloc=0,x(1..n),ds;
+     ideal M=fetch(R,M);
+     map phi=R,M;
+  }
+  ideal K=phi(K);
+  ideal I=phi(I);
+//---compute the order of I in (Q[x]/M)[[x]]/K
+  k=1;d=0;
+  while(!d)
+  {
+     k++;
+     d=size(reduce(I,std(maxideal(k)+K)));
+  }
+  setring R;
+  return(k-1);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring r = 0,(x,y,z),dp;
+   ideal I=x4+z4+1;
+   ideal K=x+y2+z2;
+   Kontakt(I,K);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc abstractNC(list BO)
+"Internal procedure - no help and no example available
+"
+{
+//--- check normal crossing property
+//--- used for passing from embedded to non-embedded resolution
+//----------------------------------------------------------------------------
+// Initialization
+//----------------------------------------------------------------------------
+  int i,k,j,flag;
+  list L;
+  ideal J;
+  if(dim(std(cent))>0){return(1);}
+//----------------------------------------------------------------------------
+// check each exceptional divisor on V(J)
+//----------------------------------------------------------------------------
+  for(i=1;i<=size(BO[4]);i++)
+  {
+    if(dim(std(BO[2]+BO[4][i]))>0)
+    {
+//--- really something to do
+      J=radical(BO[4][i]+BO[2]);
+      if(deg(std(slocus(J))[1])!=0)
+      {
+        if(!nodes(J))
+        {
+//--- really singular, not only nodes ==> not normal crossing
+          return(0);
+        }
+      }
+      for(k=1;k<=size(L);k++)
+      {
+//--- run through previously considered divisors
+//--- we do not want to bother with the same one twice
+         if((size(reduce(J,std(L[k])))==0)&&(size(reduce(L[k],std(J)))==0))
+         {
+//--- already considered this one
+            flag=1;break;
+         }
+//--- drop previously considered exceptional divisors from the current one
+         J=sat(J,L[k])[1];
+         if(deg(std(J)[1])==0)
+         {
+//--- nothing remaining
+            flag=1;break;
+         }
+      }
+      if(flag==0)
+      {
+//--- add exceptional divisor to the list
+         L[size(L)+1]=J;
+      }
+      flag=0;
+    }
+  }
+//---------------------------------------------------------------------------
+// check intersection properties between different exceptional divisors
+//---------------------------------------------------------------------------
+  for(k=1;k<size(L);k++)
+  {
+     for(i=k+1;i<=size(L);i++)
+     {
+        if(!nodes(intersect(L[k],L[i])))
+        {
+//--- divisors Ek and Ei do not meet in a node but in a singularity
+//--- which is not allowed to occur ==> not normal crossing
+           return(0);
+        }
+        for(j=i+1;j<=size(L);j++)
+        {
+           if(deg(std(L[i]+L[j]+L[k])[1])>0)
+           {
+//--- three divisors meet simultaneously ==> not normal crossing
+              return(0);
+           }
+        }
+     }
+   }
+//--- we reached this point ==> normal crossing
+   return(1);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc nodes(ideal J)
+"Internal procedure - no help and no example available
+"
+{
+//--- check whether at most nodes occur as singularities
+   ideal K=std(slocus(J));
+   if(deg(K[1])==0){return(1);}
+   if(dim(K)>0){return(0);}
+   if(vdim(K)!=vdim(std(radical(K)))){return(0);}
+   return(1);
+}
+//////////////////////////////////////////////////////////////////////////////
+
+proc intersectionDiv(list re)
+"USAGE:   intersectionDiv(L);
+@*        L = list of rings
+ASSUME:   L is output of resolution of singularities
+          (only case of isolated surface singularities)
+COMPUTE:  intersection matrix and genera of the exceptional divisors
+          (considered as curves on the strict transform)
+RETURN:   list l, where
+          l[1]: intersection matrix of exceptional divisors
+          l[2]: intvec, genera of exceptional divisors
+          l[3]: divisorList, encoding the identification of the divisors
+EXAMPLE:  example intersectionDiv;  shows an example
+"
+{
+//----------------------------------------------------------------------------
+//--- Computes in case of surface singularities (non-embedded resolution):
+//--- the intersection of the divisors (on the surface)
+//--- assuming that re=resolve(J)
+//----------------------------------------------------------------------------
+   def R=basering;
+//---Test whether we are in the irreducible surface case
+   def S=re[2][1];
+   setring S;
+   BO[2]=BO[2]+BO[1];              // make sure we are living in the smooth W
+   if(dim(std(BO[2]))!=2)
+   {
+     ERROR("The given original object is not a surface");
+   }
+   if(dim(std(slocus(BO[2])))>0)
+   {
+     ERROR("The given original object has non-isolated singularities.");
+   }
+   setring R;
+//----------------------------------------------------------------------------
+// Compute a non-embedded resolution from the given embedded one by
+// dropping redundant trailing blow-ups
+//----------------------------------------------------------------------------
+   list resu,tmpiden,templist;
+   intvec divcomp;
+   int i,j,k,offset1,offset2,a,b,c,d,q,found;
+//--- compute non-embedded resolution
+   list abst=abstractR(re);
+   intvec endiv=abst[1];
+   intvec deleted=abst[2];
+//--- identify the divisors in the various final charts
+   list iden=collectDiv(re,deleted)[2];
+                                    // list of final divisors
+   list iden0=iden;                 // backup copy of iden for later use
+
+   iden=delete(iden,size(iden));    // drop list of endRings from iden
+//---------------------------------------------------------------------------
+// In iden, only the final charts should be listed, whereas iden0 contains
+// everything.
+//---------------------------------------------------------------------------
+   for(i=1;i<=size(iden);i++)
+   {
+     k=size(iden[i]);
+     tmpiden=iden[i];
+     for(j=k;j>0;j--)
+     {
+        if(!endiv[iden[i][j][1]])
+        {
+//---not a final chart
+           tmpiden=delete(tmpiden,j);
+        }
+     }
+     if(size(tmpiden)==0)
+     {
+//--- oops, this divisor does not appear in final charts
+        iden=delete(iden,i);
+        continue;
+     }
+     else
+     {
+        iden[i]=tmpiden;
+     }
+   }
+//---------------------------------------------------------------------------
+// Even though the exceptional divisors were irreducible in the embedded
+// case, they may very well have become reducible after intersection with
+// the strict transform of the original object.
+// ===> compute a decomposition for each divisor in each of the final charts
+//      and change the entries of iden accordingly
+// In particular, it is important to keep track of the identification of the
+// components of the divisors in each of the charts
+//---------------------------------------------------------------------------
+   int n=size(iden);
+   for(i=1;i<=size(re[2]);i++)
+   {
+     if(endiv[i])
+     {
+        def SN=re[2][i];
+        setring SN;
+        if(defined(dcE)){kill dcE;}
+        list dcE=decompEinX(BO);       // decomposition of exceptional divisors
+        export(dcE);
+        setring R;
+        kill SN;
+     }
+   }
+   if(defined(tmpiden)){kill tmpiden;}
+   list tmpiden=iden;
+   for(i=1;i<=size(iden);i++)
+   {
+      for(j=size(iden[i]);j>0;j--)
+      {
+         def SN=re[2][iden[i][j][1]];
+         setring SN;
+         if(size(dcE[iden[i][j][2]])==1)
+         {
+           if(dcE[iden[i][j][2]][1][2]==0)
+           {
+             tmpiden[i]=delete(tmpiden[i],j);
+           }
+         }
+         setring R;
+         kill SN;
+      }
+   }
+   for(i=size(tmpiden);i>0;i--)
+   {
+      if(size(tmpiden[i])==0)
+      {
+         tmpiden=delete(tmpiden,i);
+      }
+   }
+   iden=tmpiden;
+   kill tmpiden;
+   list tmpiden;
+//--- change entries of iden accordingly
+   for(i=1;i<=size(iden);i++)
+   {
+//--- first set up new entries in iden if necessary - using the first chart
+//--- in which we see the respective exceptional divisor
+     if(defined(S)){kill S;}
+     def S=re[2][iden[i][1][1]];
+//--- considering first entry for i-th divisor
+     setring S;
+     a=size(dcE[iden[i][1][2]]);
+     for(j=1;j<=a;j++)
+     {
+//--- reducible - add to the list considering each component as an exceptional
+//--- divisor in its own right
+        list tl;
+        tl[1]=intvec(iden[i][1][1],iden[i][1][2],j);
+        tmpiden[size(tmpiden)+1]=tl;
+        kill tl;
+     }
+//--- now identify the components in the other charts w.r.t. the ones in the
+//--- first chart which have already been added to the list
+     for(j=2;j<=size(iden[i]);j++)
+     {
+//--- considering remaining entries for the same original divisor
+       if(defined(S2)){kill S2;}
+       def S2=re[2][iden[i][j][1]];
+       setring S2;
+//--- determine common parent of this ring and re[2][iden[i][1][1]]
+       if(defined(opath)){kill opath;}
+       def opath=imap(S,path);
+       b=1;
+       while(opath[1,b]==path[1,b])
+       {
+          b++;
+          if((b>ncols(path))||(b>ncols(opath))) break;
+       }
+       if(defined(li1)){kill li1;}
+       list li1;
+//--- fetch the components we have considered in re[2][iden[i][1][1]]
+//--- via the resolution tree
+       for(k=1;k<=a;k++)
+       {
+          string tempstr="dcE["+string(eval(iden[i][1][2]))+"]["+string(k)+"][1]";
+          if(defined(id1)){kill id1;}
+          ideal id1=fetchInTree(re,iden[i][1][1],int(leadcoef(path[1,b-1])),
+                      iden[i][j][1],tempstr,iden0,1);
+          kill tempstr;
+          li1[k]=radical(id1);        // for comparison only the geometric
+                                      // object matters
+          kill id1;
+       }
+//--- compare the components we have fetched with the components in the
+//--- current ring
+       for(k=1;k<=size(dcE[iden[i][j][2]]);k++)
+       {
+          found=0;
+          for(b=1;b<=size(li1);b++)
+          {
+             if((size(reduce(li1[b],std(dcE[iden[i][j][2]][k][1])))==0)&&
+               (size(reduce(dcE[iden[i][j][2]][k][1],std(li1[b]+BO[2])))==0))
+             {
+                li1[b]=ideal(1);
+                tmpiden[size(tmpiden)-a+b][size(tmpiden[size(tmpiden)-a+b])+1]=
+                       intvec(iden[i][j][1],iden[i][j][2],k);
+                found=1;
+                break;
+             }
+          }
+          if(!found)
+          {
+            if(!defined(repair))
+            {
+               list repair;
+               repair[1]=list(intvec(iden[i][j][1],iden[i][j][2],k));
+            }
+            else
+            {
+               for(c=1;c<=size(repair);c++)
+               {
+                  for(d=1;d<=size(repair[c]);d++)
+                  {
+                     if(defined(opath)) {kill opath;}
+                     def opath=imap(re[2][repair[c][d][1]],path);
+                     q=0;
+                     while(path[1,q+1]==opath[1,q+1])
+                     {
+                        q++;
+                        if((q>ncols(path)-1)||(q>ncols(opath)-1)) break;
+                     }
+                     q=int(leadcoef(path[1,q]));
+                     string tempstr="dcE["+string(eval(repair[c][d][2]))+"]["+string(eval(repair[c][d][3]))+"][1]";
+                     if(defined(id1)){kill id1;}
+                     ideal id1=fetchInTree(re,repair[c][d][1],q,
+                                  iden[i][j][1],tempstr,iden0,1);
+                     kill tempstr;
+//!!! sind die nicht schon radical?
+                     id1=radical(id1);        // for comparison
+                                              // only the geometric
+                                              // object matters
+                     if((size(reduce(dcE[iden[i][j][2]][k][1],std(id1+BO[2])))==0)&&
+                        (size(reduce(id1+BO[2],std(dcE[iden[i][j][2]][k][1])))==0))
+                     {
+                       repair[c][size(repair[c])+1]=intvec(iden[i][j][1],iden[i][j][2],k);
+                       break;
+                     }
+                  }
+                  if(d<=size(repair[c]))
+                  {
+                     break;
+                  }
+               }
+               if(c>size(repair))
+               {
+                  repair[size(repair)+1]=list(intvec(iden[i][j][1],iden[i][j][2],k));
+               }
+            }
+         }
+       }
+     }
+     if(defined(repair))
+     {
+       for(c=1;c<=size(repair);c++)
+       {
+          tmpiden[size(tmpiden)+1]=repair[c];
+       }
+       kill repair;
+     }
+   }
+   setring R;
+   for(i=size(tmpiden);i>0;i--)
+   {
+      if(size(tmpiden[i])==0)
+      {
+        tmpiden=delete(tmpiden,i);
+        continue;
+      }
+   }
+   iden=tmpiden;                      // store the modified divisor list
+   kill tmpiden;                      // and clean up temporary objects
+//---------------------------------------------------------------------------
+// Now we have decomposed everything into irreducible components over Q,
+// but over C there might still be some reducible ones left:
+// Determine the number of components over C.
+//---------------------------------------------------------------------------
+   n=0;
+   for(i=1;i<=size(iden);i++)
+   {
+      if(defined(S)) {kill S;}
+      def S=re[2][iden[i][1][1]];
+      setring S;
+      divcomp[i]=ncols(dcE[iden[i][1][2]][iden[i][1][3]][4]);
+          // number of components of the Q-irreducible curve dcE[iden[i][1][2]]
+      n=n+divcomp[i];
+      setring R;
+   }
+//---------------------------------------------------------------------------
+// set up the entries Inters[i,j] , i!=j, in the intersection matrix:
+// we have to compute the intersection of the exceptional divisors (over C)
+//    i.e. we have to work in over appropriate algebraic extension of Q.
+// (1) plug the intersection matrices of the components of the same Q-irred.
+//     divisor into the correct position in the intersection matrix
+// (2) for comparison of Ei,k and Ej,l move to a chart where both divisors
+//     are present, fetch the components from the very first chart containing
+//     the respective divisor and then compare by using intersComp
+// (4) put the result into the correct position in the integer matrix Inters
+//---------------------------------------------------------------------------
+//--- some initialization
+   int comPai,comPaj;
+   intvec v,w;
+   intmat Inters[n][n];
+//--- run through all Q-irreducible exceptional divisors
+   for(i=1;i<=size(iden);i++)
+   {
+      if(divcomp[i]>1)
+      {
+//--- (1) put the intersection matrix for Ei,k with Ei,l into the correct place
+         for(k=1;k<=size(iden[i]);k++)
+         {
+            if(defined(tempmat)){kill tempmat;}
+            intmat tempmat=imap(re[2][iden[i][k][1]],dcE)[iden[i][k][2]][iden[i][k][3]][4];
+            if(size(ideal(tempmat))!=0)
+            {
+               Inters[i+offset1..(i+offset1+divcomp[i]-1),
+                      i+offset1..(i+offset1+divcomp[i]-1)]=
+                       tempmat[1..nrows(tempmat),1..ncols(tempmat)];
+               break;
+            }
+            kill tempmat;
+         }
+      }
+      offset2=offset1+divcomp[i]-1;
+//--- set up the components over C of the i-th exceptional divisor
+      if(defined(S)){kill S;}
+      def S=re[2][iden[i][1][1]];
+      setring S;
+      if(defined(idlisti)) {kill idlisti;}
+      list idlisti;
+      idlisti[1]=dcE[iden[i][1][2]][iden[i][1][3]][6];
+      export(idlisti);
+      setring R;
+//--- run through the remaining exceptional divisors and check whether they
+//--- have a chart in common with the i-th divisor
+      for(j=i+1;j<=size(iden);j++)
+      {
+         kill templist;
+         list templist;
+         for(k=1;k<=size(iden[i]);k++)
+         {
+            intvec tiv2=findInIVList(1,iden[i][k][1],iden[j]);
+            if(size(tiv2)!=1)
+            {
+//--- tiv2[1] is a common chart for the divisors i and j
+              tiv2[4..6]=iden[i][k];
+              templist[size(templist)+1]=tiv2;
+            }
+            kill tiv2;
+         }
+         if(size(templist)==0)
+         {
+//--- the two (Q-irred) divisors do not appear in any chart simultaneously
+            offset2=offset2+divcomp[j]-1;
+            j++;
+            continue;
+         }
+         for(k=1;k<=size(templist);k++)
+         {
+            if(defined(S)) {kill S;}
+//--- set up the components over C of the j-th exceptional divisor
+            def S=re[2][iden[j][1][1]];
+            setring S;
+            if(defined(idlistj)) {kill idlistj;}
+            list idlistj;
+            idlistj[1]=dcE[iden[j][1][2]][iden[j][1][3]][6];
+            export(idlistj);
+            if(defined(opath)){kill opath;}
+            def opath=imap(re[2][templist[k][1]],path);
+            comPaj=1;
+            while(opath[1,comPaj]==path[1,comPaj])
+            {
+              comPaj++;
+              if((comPaj>ncols(opath))||(comPaj>ncols(path))) break;
+            }
+            comPaj=int(leadcoef(path[1,comPaj-1]));
+            setring R;
+            kill S;
+            def S=re[2][iden[i][1][1]];
+            setring S;
+            if(defined(opath)){kill opath;}
+            def opath=imap(re[2][templist[k][1]],path);
+            comPai=1;
+            while(opath[1,comPai]==path[1,comPai])
+            {
+               comPai++;
+               if((comPai>ncols(opath))||(comPai>ncols(path))) break;
+            }
+            comPai=int(leadcoef(opath[1,comPai-1]));
+            setring R;
+            kill S;
+            def S=re[2][templist[k][1]];
+            setring S;
+            if(defined(il)) {kill il;}
+            if(defined(jl)) {kill jl;}
+            if(defined(str1)) {kill str1;}
+            if(defined(str2)) {kill str2;}
+            string str1="idlisti";
+            string str2="idlistj";
+            attrib(str1,"algext",imap(re[2][iden[i][1][1]],dcE)[iden[i][1][2]][iden[i][1][3]][5]);
+            attrib(str2,"algext",imap(re[2][iden[j][1][1]],dcE)[iden[j][1][2]][iden[j][1][3]][5]);
+            list il=fetchInTree(re,iden[i][1][1],comPai,
+                                templist[k][1],str1,iden0,1);
+            list jl=fetchInTree(re,iden[j][1][1],comPaj,
+                                templist[k][1],str2,iden0,1);
+            list nulli=imap(re[2][iden[i][1][1]],dcE)[iden[i][1][2]][iden[i][1][3]][7];
+            list nullj=imap(re[2][iden[j][1][1]],dcE)[iden[j][1][2]][iden[j][1][3]][7];
+            string mpi=imap(re[2][iden[i][1][1]],dcE)[iden[i][1][2]][iden[i][1][3]][5];
+            string mpj=imap(re[2][iden[j][1][1]],dcE)[iden[j][1][2]][iden[j][1][3]][5];
+            if(defined(tintMat)){kill tintMat;}
+            intmat tintMat=intersComp(il[1],mpi,nulli,jl[1],mpj,nullj);
+            kill mpi;
+            kill mpj;
+            kill nulli;
+            kill nullj;
+            for(a=1;a<=divcomp[i];a++)
+            {
+               for(b=1;b<=divcomp[j];b++)
+               {
+                 if(tintMat[a,b]!=0)
+                 {
+                    Inters[i+offset1+a-1,j+offset2+b-1]=tintMat[a,b];
+                    Inters[j+offset2+b-1,i+offset1+a-1]=tintMat[a,b];
+                 }
+               }
+            }
+         }
+         offset2=offset2+divcomp[j]-1;
+      }
+      offset1=offset1+divcomp[i]-1;
+   }
+   Inters=addSelfInter(re,Inters,iden,iden0,endiv);
+   intvec GenusIden;
+
+   list tl_genus;
+   a=1;
+   for(i=1;i<=size(iden);i++)
+   {
+      tl_genus=genus_E(re,iden0,iden[i][1]);
+      for(j=1;j<=tl_genus[2];j++)
+      {
+        GenusIden[a]=tl_genus[1];
+        a++;
+      }
+   }
+
+   list retlist=Inters,GenusIden,iden,divcomp;
+   return(retlist);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring r = 0,(x(1..3)),dp(3);
+   ideal J=x(3)^5+x(2)^4+x(1)^3+x(1)*x(2)*x(3);
+   list re=resolve(J);
+   list di=intersectionDiv(re);
+   di;
+
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc intersComp(string str1,
+                string mp1,
+                list null1,
+                string str2,
+                string mp2,
+                list null2)
+"Internal procedure - no help and no example available
+"
+{
+//--- format of input
+//--- str1 : ideal (over field extension 1)
+//--- mp1  : minpoly of field extension 1
+//--- null1: numerical zeros of minpoly
+//--- str2 : ideal (over field extension 2)
+//--- mp2  : minpoly of field extension 2
+//--- null2: numerical zeros of minpoly
+
+//--- determine intersection matrix of the C-components defined by the input
+
+//---------------------------------------------------------------------------
+// Initialization
+//---------------------------------------------------------------------------
+  int ii,jj,same;
+  def R=basering;
+  intmat InterMat[size(null1)][size(null2)];
+  ring ringst=0,(t,s),dp;
+//---------------------------------------------------------------------------
+// Add new variables s and t and compare the minpolys and ideals
+// to find out whether they are identical
+//---------------------------------------------------------------------------
+  def S=R+ringst;
+  setring S;
+  if((mp1==mp2)&&(str1==str2))
+  {
+    same=1;
+  }
+//--- define first Q-component/C-components, substitute t by s
+  string tempstr="ideal id1="+str1+";";
+  execute(tempstr);
+  execute(mp1);
+  id1=subst(id1,t,s);
+  poly q=subst(p,t,s);
+  kill p;
+//--- define second Q-component/C-components
+  tempstr="ideal id2="+str2+";";
+  execute(tempstr);
+  execute(mp2);
+//--- do the intersection
+  ideal interId=id1+id2+ideal(p)+ideal(q);
+  if(same)
+  {
+    interId=quotient(interId,t-s);
+  }
+  interId=std(interId);
+//--- refine the comparison by passing to each of the numerical zeros
+//--- of the two minpolys
+  ideal stid=nselect(interId,1,nvars(R));
+  ring compl_st=complex,(s,t),dp;
+  def stid=imap(S,stid);
+  ideal tempid,tempid2;
+  for(ii=1;ii<=size(null1);ii++)
+  {
+    tempstr="number numi="+null1[ii]+";";
+    execute(tempstr);
+    tempid=subst(stid,s,numi);
+    kill numi;
+    for(jj=1;jj<=size(null2);jj++)
+    {
+       tempstr="number numj="+null2[jj]+";";
+       execute(tempstr);
+       tempid2=subst(tempid,t,numj);
+       kill numj;
+       if(size(tempid2)==0)
+       {
+         InterMat[ii,jj]=1;
+       }
+    }
+  }
+//--- sanity check; as both Q-components were Q-irreducible,
+//--- summation over all entries of a single row must lead to the same
+//--- result, no matter which row is chosen
+//--- dito for the columns
+  int cou,cou1;
+  for(ii=1;ii<=ncols(InterMat);ii++)
+  {
+    cou=0;
+    for(jj=1;jj<=nrows(InterMat);jj++)
+    {
+      cou=cou+InterMat[jj,ii];
+    }
+    if(ii==1){cou1=cou;}
+    if(cou1!=cou){ERROR("intersComp:matrix has wrong entries");}
+  }
+  for(ii=1;ii<=nrows(InterMat);ii++)
+  {
+    cou=0;
+    for(jj=1;jj<=ncols(InterMat);jj++)
+    {
+      cou=cou+InterMat[ii,jj];
+    }
+    if(ii==1){cou1=cou;}
+    if(cou1!=cou){ERROR("intersComp:matrix has wrong entries");}
+  }
+  return(InterMat);
+}
+/////////////////////////////////////////////////////////////////////////////
+static
+proc addSelfInter(list re,intmat Inters,list iden,list iden0,intvec endiv)
+"Internal procedure - no help and no example available
+"
+{
+//---------------------------------------------------------------------------
+// Initialization
+//---------------------------------------------------------------------------
+   def R=basering;
+   int i,j,k,l,a,b;
+   int n=size(iden);
+   intvec v,w;
+   list satlist;
+   def T=re[2][1];
+   setring T;
+   poly p;
+   p=var(1);  //any linear form will do,
+              //but this one is most convenient
+   ideal F=ideal(p);
+//----------------------------------------------------------------------------
+// lift linear form to every end ring, determine the multiplicity of
+// the exceptional divisors and store it in Flist
+//----------------------------------------------------------------------------
+   list templist;
+   intvec tiv;
+   for(i=1;i<=size(endiv);i++)
+   {
+     if(endiv[i]==1)
+     {
+        kill v;
+        intvec v;
+        a=0;
+        if(defined(S)) {kill S;}
+        def S=re[2][i];
+        setring S;
+        map resi=T,BO[5];
+        ideal F=resi(F)+BO[2];
+        ideal Ftemp=F;
+        list Flist;
+        if(defined(satlist)){kill satlist;}
+        list satlist;
+        for(a=1;a<=size(dcE);a++)
+        {
+           for(b=1;b<=size(dcE[a]);b++)
+           {
+              Ftemp=sat(Ftemp,dcE[a][b][1])[1];
+           }
+        }
+        F=sat(F,Ftemp)[1];
+        Flist[1]=Ftemp;
+        Ftemp=1;
+        list pr=primdecGTZ(F);
+        v[size(pr)]=0;
+        for(j=1;j<=size(pr);j++)
+        {
+          for(a=1;a<=size(dcE);a++)
+          {
+             if(j==1)
+             {
+               kill tiv;
+               intvec tiv;
+               tiv[size(dcE[a])]=0;
+               templist[a]=tiv;
+               if(v[j]==1)
+               {
+                 a++;
+                 continue;
+               }
+             }
+             if(dcE[a][1][2]==0)
+             {
+                a++;
+                continue;
+             }
+             for(b=1;b<=size(dcE[a]);b++)
+             {
+                if((size(reduce(dcE[a][b][1],std(pr[j][2])))==0)&&
+                   (size(reduce(pr[j][2],std(dcE[a][b][1])))==0))
+                {
+                  templist[a][b]=Vielfachheit(pr[j][1],pr[j][2]);
+                  v[j]=1;
+                  break;
+                }
+             }
+             if((v[j]==1)&&(j>1)) break;
+          }
+        }
+        kill v;
+        intvec v;
+        Flist[2]=templist;
+     }
+   }
+//-----------------------------------------------------------------------------
+// Now set up all the data:
+// 1. run through all exceptional divisors in iden and determine the
+//    coefficients c_i of the divisor of F.  ===> civ
+// 2. determine the intersection locus of F^bar and the Ei and from this data
+//    the F^bar.Ei . ===> intF
+//-----------------------------------------------------------------------------
+   intvec civ;
+   intvec intF;
+   intF[ncols(Inters)]=0;
+   int offset,comPa,ncomp,vd;
+   for(i=1;i<=size(iden);i++)
+   {
+      ncomp=0;
+      for(j=1;j<=size(iden[i]);j++)
+      {
+        if(defined(S)) {kill S;}
+        def S=re[2][iden[i][j][1]];
+        setring S;
+        if((size(civ)<i+offset+1)&&
+           (((Flist[2][iden[i][j][2]][iden[i][j][3]])!=0)||(j==size(iden[i]))))
+        {
+           ncomp=ncols(dcE[iden[i][j][2]][iden[i][j][3]][4]);
+           for(k=1;k<=ncomp;k++)
+           {
+              civ[i+offset+k]=Flist[2][iden[i][j][2]][iden[i][j][3]];
+              if(deg(std(slocus(dcE[iden[i][j][2]][iden[i][j][3]][1]))[1])>0)
+              {
+                   civ[i+offset+k]=civ[i+k];
+              }
+           }
+        }
+        if(defined(interId)) {kill interId;}
+        ideal interId=dcE[iden[i][j][2]][iden[i][j][3]][1]+Flist[1];
+        if(defined(interList)) {kill interList;}
+        list interList;
+        interList[1]=string(interId);
+        interList[2]=ideal(0);
+        export(interList);
+        if(defined(doneId)) {kill doneId;}
+        if(defined(tempId)) {kill tempId;}
+        ideal doneId=ideal(1);
+        if(defined(dl)) {kill dl;}
+        list dl;
+        for(k=1;k<j;k++)
+        {
+           if(defined(St)) {kill St;}
+           def St=re[2][iden[i][k][1]];
+           setring St;
+           if(defined(str)){kill str;}
+           string str="interId="+interList[1]+";";
+           execute(str);
+           if(deg(std(interId)[1])==0)
+           {
+             setring S;
+             k++;
+             continue;
+           }
+           setring S;
+           if(defined(opath)) {kill opath;}
+           def opath=imap(re[2][iden[i][k][1]],path);
+           comPa=1;
+           while(opath[1,comPa]==path[1,comPa])
+           {
+              comPa++;
+              if((comPa>ncols(path))||(comPa>ncols(opath))) break;
+           }
+           comPa=int(leadcoef(path[1,comPa-1]));
+           if(defined(str)) {kill str;}
+           string str="interList";
+           attrib(str,"algext","poly p=t-1;");
+           dl=fetchInTree(re,iden[i][k][1],comPa,iden[i][j][1],str,iden0,1);
+           if(defined(tempId)){kill tempId;}
+           str="ideal tempId="+dl[1]+";";
+           execute(str);
+           doneId=intersect(doneId,tempId);
+           str="interId="+interList[1]+";";
+           execute(str);
+           interId=sat(interId,doneId)[1];
+           interList[1]=string(interId);
+        }
+        interId=std(interId);
+        if(dim(interId)>0)
+        {
+           "oops, intersection not a set of points";
+           ~;
+        }
+        vd=vdim(interId);
+        if(vd>0)
+        {
+          for(k=i+offset;k<=i+offset+ncomp-1;k++)
+          {
+             intF[k]=intF[k]+(vd/ncomp);
+          }
+        }
+      }
+      offset=size(civ)-i-1;
+   }
+   if(defined(tiv)){kill tiv;}
+   intvec tiv=civ[2..size(civ)];
+   civ=tiv;
+   kill tiv;
+//-----------------------------------------------------------------------------
+// Using the F_total= sum c_i Ei + F^bar, the intersection matrix Inters and
+// the f^bar.Ei, determine the selfintersection numbers of the Ei from the
+// equation F_total.Ei=0 and store it in the diagonal of Inters.
+//-----------------------------------------------------------------------------
+   intvec diag=Inters*civ+intF;
+   for(i=1;i<=size(diag);i++)
+   {
+      Inters[i,i]=-diag[i]/civ[i];
+   }
+   return(Inters);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc invSort(list re, list #)
+"Internal procedure - no help and no example available
+"
+{
+  int i,j,k,markier,EZeiger,offset;
+  intvec v,e;
+  intvec deleted;
+  if(size(#)>0)
+  {
+     deleted=#[1];
+  }
+  else
+  {
+    deleted[size(re[2])]=0;
+  }
+  list LE,HI;
+  def R=basering;
+//----------------------------------------------------------------------------
+// Go through all rings
+//----------------------------------------------------------------------------
+  for(i=1;i<=size(re[2]);i++)
+  {
+     if(deleted[i]){i++;continue}
+     def S=re[2][i];
+     setring S;
+//----------------------------------------------------------------------------
+// Determine Invariant
+//----------------------------------------------------------------------------
+     if((size(BO[3])==size(BO[9]))||(size(BO[3])==size(BO[9])+1))
+     {
+        if(defined(merk2)){kill merk2;}
+        intvec merk2;
+        EZeiger=0;
+        for(j=1;j<=size(BO[9]);j++)
+        {
+          offset=0;
+          if(BO[7][j]==-1)
+          {
+             BO[7][j]=size(BO[4])-EZeiger;
+          }
+          for(k=EZeiger+1;(k<=EZeiger+BO[7][j])&&(k<=size(BO[4]));k++)
+          {
+             if(BO[6][k]==2)
+             {
+                offset++;
+             }
+          }
+          EZeiger=EZeiger+BO[7][1];
+          merk2[3*j-2]=BO[3][j];
+          merk2[3*j-1]=BO[9][j]-offset;
+          if(size(invSat[2])>j)
+          {
+            merk2[3*j]=-invSat[2][j];
+          }
+          else
+          {
+            if(j<size(BO[9]))
+            {
+               "!!!!!problem with invSat";~;
+            }
+          }
+        }
+        if((size(BO[3])>size(BO[9])))
+        {
+          merk2[size(merk2)+1]=BO[3][size(BO[3])];
+        }
+        if((size(merk2)%3)==0)
+        {
+          intvec tintvec=merk2[1..size(merk2)-1];
+          merk2=tintvec;
+          kill tintvec;
+        }
+     }
+     else
+     {
+         ERROR("This situation should not occur, please send the example
+                 to the authors.");
+     }
+//----------------------------------------------------------------------------
+// Save invariant describing current center as an object in this ring
+// We also store information on the intersection with the center and the
+// exceptional divisors
+//----------------------------------------------------------------------------
+     cent=std(cent);
+     kill e;
+     intvec e;
+     for(j=1;j<=size(BO[4]);j++)
+     {
+        if(size(reduce(BO[4][j],std(cent+BO[1])))==0)
+        {
+           e[j]=1;
+        }
+        else
+        {
+           e[j]=0;
+        }
+     }
+     if(size(ideal(merk2))==0)
+     {
+        markier=1;
+     }
+     if((size(merk2)%3==0)&&(merk2[size(merk2)]==0))
+     {
+       intvec blabla=merk2[1..size(merk2)-1];
+       merk2=blabla;
+       kill blabla;
+     }
+     if(defined(invCenter)){kill invCenter;}
+     list invCenter=cent,merk2,e;
+     export invCenter;
+//----------------------------------------------------------------------------
+// Insert it into correct place in the list
+//----------------------------------------------------------------------------
+     if(i==1)
+     {
+       if(!markier)
+       {
+         HI=intvec(merk2[1]+1),intvec(1);
+       }
+       else
+       {
+         HI=intvec(778),intvec(1);   // some really large integer
+                                     // will be changed at the end!!!
+       }
+       LE[1]=HI;
+       i++;
+       setring R;
+       kill S;
+       continue;
+     }
+     if(markier==1)
+     {
+       if(i==2)
+       {
+         HI=intvec(777),intvec(2);   // same really large integer-1
+         LE[2]=HI;
+         i++;
+         setring R;
+         kill S;
+         continue;
+       }
+       else
+       {
+         if(ncols(path)==2)
+         {
+           LE[2][2][size(LE[2][2])+1]=i;
+           i++;
+           setring R;
+           kill S;
+           continue;
+         }
+         else
+         {
+           markier=0;
+         }
+       }
+     }
+     j=1;
+     def SOld=re[2][int(leadcoef(path[1,ncols(path)]))];
+     setring SOld;
+     merk2=invCenter[2];
+     setring S;
+     kill SOld;
+     while(merk2<LE[j][1])
+     {
+        j++;
+        if(j>size(LE)) break;
+     }
+     HI=merk2,intvec(i);
+     if(j<=size(LE))
+     {
+        if(merk2>LE[j][1])
+        {
+          LE=insert(LE,HI,j-1);
+        }
+        else
+        {
+           while((merk2==LE[j][1])&&(size(merk2)<size(LE[j][1])))
+           {
+              j++;
+              if(j>size(LE)) break;
+           }
+           if(j<=size(LE))
+           {
+              if((merk2!=LE[j][1])||(size(merk2)!=size(LE[j][1])))
+              {
+                LE=insert(LE,HI,j-1);
+              }
+              else
+              {
+                LE[j][2][size(LE[j][2])+1]=i;
+              }
+           }
+           else
+           {
+              LE[size(LE)+1]=HI;
+           }
+        }
+     }
+     else
+     {
+        LE[size(LE)+1]=HI;
+     }
+     setring R;
+     kill S;
+  }
+  if((LE[1][1]==intvec(778)) && (size(LE)>2))
+  {
+     LE[1][1]=intvec(LE[3][1][1]+2);     // by now we know what 'sufficiently
+     LE[2][1]=intvec(LE[3][1][1]+1);     // large' is
+  }
+  return(LE);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring r = 0,(x(1..3)),dp(3);
+   ideal J=x(1)^3-x(1)*x(2)^3+x(3)^2;
+   list re=resolve(J,1);
+   list di=invSort(re);
+   di;
+}
+/////////////////////////////////////////////////////////////////////////////
+static
+proc addToRE(intvec v,int x,list RE)
+"Internal procedure - no help and no example available
+"
+{
+//--- auxilliary procedure for collectDiv,
+//--- inserting an entry at the correct place
+   int i=1;
+   while(i<=size(RE))
+   {
+      if(v==RE[i][1])
+      {
+         RE[i][2][size(RE[i][2])+1]=x;
+         return(RE);
+      }
+      if(v>RE[i][1])
+      {
+         list templist=v,intvec(x);
+         RE=insert(RE,templist,i-1);
+         return(RE);
+      }
+      i++;
+   }
+   list templist=v,intvec(x);
+   RE=insert(RE,templist,size(RE));
+   return(RE);
+}
+////////////////////////////////////////////////////////////////////////////
+
+proc collectDiv(list re,list #)
+"USAGE:   collectDiv(L);
+@*        L = list of rings
+ASSUME:   L is output of resolution of singularities
+COMPUTE:  list representing the identification of the exceptional divisors
+          in the various charts
+RETURN:   list l, where
+          l[1]: intmat, entry k in position i,j implies BO[4][j] of chart i
+                is divisor k (if k!=0)
+                if k==0, no divisor corresponding to i,j
+          l[2]: list ll, where each entry of ll is a list of intvecs
+                entry i,j in list ll[k] implies BO[4][j] of chart i
+                is divisor k
+          l[3]: list L
+EXAMPLE:  example collectDiv;   shows an example
+"
+{
+//------------------------------------------------------------------------
+// Initialization
+//------------------------------------------------------------------------
+  int i,j,k,l,m,maxk,maxj,mPa,oPa,interC,pa,ignoreL,iTotal;
+  int mLast,oLast=1,1;
+  intvec deleted;
+//--- sort the rings by the invariant which controlled the last of the
+//--- exceptional divisors
+  if(size(#)>0)
+  {
+     deleted=#[1];
+  }
+  else
+  {
+    deleted[size(re[2])]=0;
+  }
+  list LE=invSort(re,deleted);
+  list LEtotal=LE;
+  intmat M[size(re[2])][size(re[2])];
+  intvec invar,tempiv;
+  def R=basering;
+  list divList;
+  list RE,SE;
+  intvec myEi,otherEi,tempe;
+  int co=2;
+
+  while(size(LE)>0)
+  {
+//------------------------------------------------------------------------
+// Run through the sorted list LE whose entries are lists containing
+// the invariant and the numbers of all rings corresponding to it
+//------------------------------------------------------------------------
+     for(i=co;i<=size(LE);i++)
+     {
+//--- i==1 in first iteration:
+//--- the original ring which did not arise from a blow-up
+//--- hence there are no exceptional divisors to be identified there ;
+
+//------------------------------------------------------------------------
+// For each fixed value of the invariant, run through all corresponding
+// rings
+//------------------------------------------------------------------------
+        for(l=1;l<=size(LE[i][2]);l++)
+        {
+           if(defined(S)){kill S;}
+           def S=re[2][LE[i][2][l]];
+           setring S;
+           if(size(BO[4])>maxj){maxj=size(BO[4]);}
+//--- all exceptional divisors, except the last one, were previously
+//--- identified - hence we can simply inherit the data from the parent ring
+           for(j=1;j<size(BO[4]);j++)
+           {
+              if(deg(std(BO[4][j])[1])>0)
+              {
+                k=int(leadcoef(path[1,ncols(path)]));
+                k=M[k,j];
+                if(k==0)
+                {
+                   RE=addToRE(LE[i][1],LE[i][2][l],RE);
+                   ignoreL=1;
+                   break;
+                }
+                M[LE[i][2][l],j]=k;
+                tempiv=LE[i][2][l],j;
+                divList[k][size(divList[k])+1]=tempiv;
+              }
+           }
+          if(ignoreL){ignoreL=0;l++;continue;}
+//----------------------------------------------------------------------------
+// In the remaining part of the procedure, the identification of the last
+// exceptional divisor takes place.
+// Step 1: check whether there is a previously considered ring with the
+//         same parent; if this is the case, we can again inherit the data
+// Step 1':check whether the parent had a stored center which it then used
+//         in this case, we are dealing with an additional component of this
+//         divisor: store it in the integer otherComp
+// Step 2: if no appropriate ring was found in step 1, we check whether
+//         there is a previously considered ring, in the parent of which
+//         the center intersects the same exceptional divisors as the center
+//         in our parent.
+//         if such a ring does not exist: new exceptional divisor
+//         if it exists: see below
+//----------------------------------------------------------------------------
+           if(path[1,ncols(path)-1]==0)
+           {
+//--- current ring originated from very first blow-up
+//--- hence exceptional divisor is the first one
+              M[LE[i][2][l],1]=1;
+              if(size(divList)>0)
+              {
+                 divList[1][size(divList[1])+1]=intvec(LE[i][2][l],j);
+              }
+              else
+              {
+                 divList[1]=list(intvec(LE[i][2][l],j));
+              }
+              l++;
+              continue;
+           }
+           if(l==1)
+           {
+              list TE=addToRE(LE[i][1],1,SE);
+              if(size(TE)!=size(SE))
+              {
+//--- new value of invariant hence new exceptional divisor
+                 SE=TE;
+                 divList[size(divList)+1]=list(intvec(LE[i][2][l],j));
+                 M[LE[i][2][l],j]=size(divList);
+              }
+              kill TE;
+           }
+           for(k=1;k<=size(LEtotal);k++)
+           {
+              if(LE[i][1]==LEtotal[k][1])
+              {
+                 iTotal=k;
+                 break;
+              }
+           }
+//--- Step 1
+           k=1;
+           while(LEtotal[iTotal][2][k]<LE[i][2][l])
+           {
+              if(defined(tempPath)){kill tempPath;}
+              def tempPath=imap(re[2][LEtotal[iTotal][2][k]],path);
+              if(tempPath[1,ncols(tempPath)]==path[1,ncols(path)])
+              {
+//--- Same parent, hence we inherit our data
+                 m=size(imap(re[2][LEtotal[iTotal][2][k]],BO)[4]);
+                 m=M[LEtotal[iTotal][2][k],m];
+                 if(m==0)
+                 {
+                    RE=addToRE(LE[i][1],LE[i][2][l],RE);
+                    ignoreL=1;
+                    break;
+                 }
+                 M[LE[i][2][l],j]=m;
+                 tempiv=LE[i][2][l],j;
+                 divList[m][size(divList[m])+1]=tempiv;
+                 break;
+              }
+              k++;
+              if(k>size(LEtotal[iTotal][2])) {break;}
+           }
+           if(ignoreL){ignoreL=0;l++;continue;}
+//--- Step 1', if necessary
+           if(M[LE[i][2][l],j]==0)
+           {
+             int savedCent;
+             def SPa1=re[2][int(leadcoef(path[1,ncols(path)]))];
+                       // parent ring
+             setring SPa1;
+             if(size(BO)>9)
+             {
+                if(size(BO[10])>0)
+                {
+                   savedCent=1;
+                }
+             }
+             if(!savedCent)
+             {
+                def SPa2=re[2][int(leadcoef(path[1,ncols(path)]))];
+                map lMa=SPa2,lastMap;
+                       // map leading from grandparent to parent
+                list transBO=lMa(BO);
+                       // actually we only need BO[10], but this is an
+                       // object not a name
+                list tempsat;
+                if(size(transBO)>9)
+                {
+//--- there were saved centers
+                   while((k<=size(transBO[10])) & (savedCent==0))
+                   {
+                      tempsat=sat(transBO[10][k][1],BO[4][size(BO[4])]);
+                      if(deg(tempsat[1][1])!=0)
+                      {
+//--- saved center can be seen in this affine chart
+                        if((size(reduce(tempsat[1],std(cent)))==0) &&
+                           (size(reduce(cent,tempsat[1]))==0))
+                        {
+//--- this was the saved center which was used
+                           savedCent=1;
+                        }
+                      }
+                      k++;
+                   }
+                }
+                kill lMa;          // clean up temporary objects
+                kill tempsat;
+                kill transBO;
+             }
+             setring S;         // back to the ring which we want to consider
+             if(savedCent==1)
+             {
+               vector otherComp;
+               otherComp[M[int(leadcoef(path[1,ncols(path)])),size(BO[4])-1]]
+                        =1;
+             }
+             kill savedCent;
+             if (defined(SPa2)){kill SPa2;}
+             kill SPa1;
+           }
+//--- Step 2, if necessary
+           if(M[LE[i][2][l],j]==0)
+           {
+//--- we are not done after step 1 and 2
+              pa=int(leadcoef(path[1,ncols(path)]));  // parent ring
+              tempe=imap(re[2][pa],invCenter)[3];     // intersection there
+              kill myEi;
+              intvec myEi;
+              for(k=1;k<=size(tempe);k++)
+              {
+                if(tempe[k]==1)
+                {
+//--- center meets this exceptional divisor
+                   myEi[size(myEi)+1]=M[pa,k];
+                   mLast=k;
+                }
+              }
+//--- ring in which the last divisor we meet is new-born
+              mPa=int(leadcoef(path[1,mLast+2]));
+              k=1;
+              while(LEtotal[iTotal][2][k]<LE[i][2][l])
+              {
+//--- perform the same preparations for the ring we want to compare with
+                 if(defined(tempPath)){kill tempPath;}
+                 def tempPath=imap(re[2][LEtotal[iTotal][2][k]],path);
+                                                          // its ancestors
+                 tempe=imap(re[2][int(leadcoef(tempPath[1,ncols(tempPath)]))],
+                         invCenter)[3];                   // its intersections
+                 kill otherEi;
+                 intvec otherEi;
+                 for(m=1;m<=size(tempe);m++)
+                 {
+                   if(tempe[m]==1)
+                   {
+//--- its center meets this exceptional divisor
+                     otherEi[size(otherEi)+1]
+                          =M[int(leadcoef(tempPath[1,ncols(tempPath)])),m];
+                     oLast=m;
+                   }
+                 }
+                 if(myEi!=otherEi)
+                 {
+//--- not the same center because of intersection properties with the
+//--- exceptional divisor
+                    k++;
+                    if(k>size(LEtotal[iTotal][2]))
+                    {
+                      break;
+                    }
+                    else
+                    {
+                      continue;
+                    }
+                 }
+//----------------------------------------------------------------------------
+// Current situation:
+// 1. the last exceptional divisor could not be identified by simply
+//    considering its parent
+// 2. it could not be proved to be a new one by considering its intersections
+//    with previous exceptional divisors
+//----------------------------------------------------------------------------
+                 if(defined(bool1)) { kill bool1;}
+                 int bool1=
+                       compareE(re,LE[i][2][l],LEtotal[iTotal][2][k],divList);
+                 if(bool1)
+                 {
+//--- found some non-empty intersection
+                    if(bool1==1)
+                    {
+//--- it is really the same exceptional divisor
+                       m=size(imap(re[2][LEtotal[iTotal][2][k]],BO)[4]);
+                       m=M[LEtotal[iTotal][2][k],m];
+                       if(m==0)
+                       {
+                          RE=addToRE(LE[i][1],LE[i][2][l],RE);
+                          ignoreL=1;
+                          break;
+                       }
+                       M[LE[i][2][l],j]=m;
+                       tempiv=LE[i][2][l],j;
+                       divList[m][size(divList[m])+1]=tempiv;
+                       break;
+                    }
+                    else
+                    {
+                       m=size(imap(re[2][LEtotal[iTotal][2][k]],BO)[4]);
+                       m=M[LEtotal[iTotal][2][k],m];
+                       if(m!=0)
+                       {
+                          otherComp[m]=1;
+                       }
+                    }
+                 }
+                 k++;
+                 if(k>size(LEtotal[iTotal][2]))
+                 {
+                   break;
+                 }
+              }
+              if(ignoreL){ignoreL=0;l++;continue;}
+              if( M[LE[i][2][l],j]==0)
+              {
+                 divList[size(divList)+1]=list(intvec(LE[i][2][l],j));
+                 M[LE[i][2][l],j]=size(divList);
+              }
+           }
+           setring R;
+           kill S;
+        }
+     }
+     LE=RE;
+     co=1;
+     kill RE;
+     list RE;
+  }
+//----------------------------------------------------------------------------
+// Add the strict transform to the list of divisors at the last place
+// and clean up M
+//----------------------------------------------------------------------------
+//--- add strict transform
+  for(i=1;i<=size(re[2]);i++)
+  {
+     if(defined(S)){kill S;}
+     def S=re[2][i];
+     setring S;
+     if(size(reduce(cent,std(BO[2])))==0)
+     {
+        tempiv=i,0;
+        RE[size(RE)+1]=tempiv;
+     }
+     setring R;
+  }
+  divList[size(divList)+1]=RE;
+//--- drop trailing zero-columns of M
+  intvec iv0;
+  iv0[nrows(M)]=0;
+  for(i=ncols(M);i>0;i--)
+  {
+    if(intvec(M[1..nrows(M),i])!=iv0) break;
+  }
+  intmat N[nrows(M)][i];
+  for(i=1;i<=ncols(N);i++)
+  {
+    N[1..nrows(M),i]=M[1..nrows(M),i];
+  }
+  kill M;
+  intmat M=N;
+  list retlist=cleanUpDiv(re,M,divList);
+  return(retlist);
+}
+example
+{"EXAMPLE:";
+   echo = 2;
+   ring R=0,(x,y,z),dp;
+   ideal I=xyz+x4+y4+z4;
+//we really need to blow up curves even if the generic point of
+//the curve the total transform is n.c.
+//this occurs here in r[2][5]
+   list re=resolve(I,1);
+   list di=collectDiv(re);
+   di;
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc cleanUpDiv(list re,intmat M,list divList)
+"Internal procedure - no help and no example available
+"
+{
+//--- It may occur that two different entries of invSort coincide on the
+//--- first part up to the last entry of the shorter one. In this case
+//--- exceptional divisors may appear in both entries of the invSort-list.
+//--- To correct this, we now compare the final collection of Divisors
+//--- for coinciding ones.
+   int i,j,k,a,oPa,mPa,comPa,mdim,odim;
+   def R=basering;
+   for(i=1;i<=size(divList)-2;i++)
+   {
+      if(defined(Sm)){kill Sm;}
+      def Sm=re[2][divList[i][1][1]];
+      setring Sm;
+      mPa=int(leadcoef(path[1,ncols(path)]));
+      if(defined(SmPa)){kill SmPa;}
+      def SmPa=re[2][mPa];
+      setring SmPa;
+      mdim=dim(std(BO[1]+cent));
+      setring Sm;
+      if(mPa==1)
+      {
+//--- very first divisor originates exactly from the first blow-up
+//--- there cannot be any mistake here
+         i++;
+         continue;
+      }
+      for(j=i+1;j<=size(divList)-1;j++)
+      {
+         setring Sm;
+         for(k=1;k<=size(divList[j]);k++)
+         {
+            if(size(findInIVList(1,divList[j][k][1],divList[i]))>1)
+            {
+//--- same divisor cannot appear twice in the same chart
+               k=-1;
+               break;
+            }
+         }
+         if(k==-1)
+         {
+            j++;
+            if(j>size(divList)-1) break;
+            continue;
+         }
+         if(defined(opath)){kill opath;}
+         def opath=imap(re[2][divList[j][1][1]],path);
+         oPa=int(leadcoef(opath[1,ncols(opath)]));
+         if(defined(SoPa)){kill SoPa;}
+         def SoPa=re[2][oPa];
+         setring SoPa;
+         odim=dim(std(BO[1]+cent));
+         setring Sm;
+         if(mdim!=odim)
+         {
+//--- different dimension ==> cannot be same center
+            j++;
+            if(j>size(divList)-1) break;
+            continue;
+         }
+         comPa=1;
+         while(path[1,comPa]==opath[1,comPa])
+         {
+           comPa++;
+           if((comPa>ncols(path))||(comPa>ncols(opath))) break;
+         }
+         comPa=int(leadcoef(path[1,comPa-1]));
+         if(defined(SPa)){kill SPa;}
+         def SPa=re[2][mPa];
+         setring SPa;
+         if(defined(tempIdE)){kill tempIdE;}
+         ideal tempIdE=fetchInTree(re,oPa,comPa,mPa,"cent",divList);
+         if((size(reduce(cent,std(tempIdE)))!=0)||
+            (size(reduce(tempIdE,std(cent)))!=0))
+         {
+//--- it is not the same divisor!
+            j++;
+            if(j>size(divList))
+            {
+               break;
+            }
+            else
+            {
+               continue;
+            }
+         }
+         for(k=1;k<=size(divList[j]);k++)
+         {
+//--- append the entries of the j-th divisor (which is actually also the i-th)
+//--- to the i-th divisor
+            divList[i][size(divList[i])+1]=divList[j][k];
+         }
+         divList=delete(divList,j);  //kill obsolete entry from the list
+         for(k=1;k<=nrows(M);k++)
+         {
+            for(a=1;a<=ncols(M);a++)
+            {
+               if(M[k,a]==j)
+               {
+//--- j-th divisor is actually the i-th one
+                  M[k,a]=i;
+               }
+               if(M[k,a]>j)
+               {
+//--- index j was deleted from the list ==> all subsequent indices dropped by
+//--- one
+                  M[k,a]=M[k,a]-1;
+               }
+            }
+         }
+         j--;                        //do not forget to consider new j-th entry
+      }
+   }
+   setring R;
+   list retlist=M,divList;
+   return(retlist);
+}
+/////////////////////////////////////////////////////////////////////////////
+static
+proc findTrans(ideal Z, ideal E, list notE, list #)
+"Internal procedure - no help and no example available
+"
+{
+//---Auxilliary procedure for fetchInTree!
+//---Assume E prime ideal, Z+E eqidimensional,
+//---ht(E)+r=ht(Z+E). Compute  P=<p[1],...,p[r]> in Z+E, and poly f,
+//---such that radical(Z+E)=radical((E+P):f)
+   int i,j,d,e;
+   ideal Estd=std(E);
+//!!! alternative to subsequent line:
+//!!!           ideal Zstd=std(radical(Z+E));
+   ideal Zstd=std(Z+E);
+   ideal J=1;
+   if(size(#)>0)
+   {
+      J=#[1];
+   }
+   if(deg(Zstd[1])==0){return(list(ideal(1),poly(1)));}
+   for(i=1;i<=size(notE);i++)
+   {
+      notE[i]=std(notE[i]);
+   }
+   ideal Zred=simplify(reduce(Z,Estd),2);
+   if(size(Zred)==0){Z,Estd;~;ERROR("Z is contained in E");}
+   ideal P,Q,Qstd;
+   Q=Estd;
+   attrib(Q,"isSB",1);
+   d=dim(Estd);
+   e=dim(Zstd);
+   for(i=1;i<=size(Zred);i++)
+   {
+      Qstd=std(Q,Zred[i]);
+      if(dim(Qstd)<d)
+      {
+         d=dim(Qstd);
+         P[size(P)+1]=Zred[i];
+         Q=Qstd;
+         attrib(Q,"isSB",1);
+         if(d==e) break;
+      }
+   }
+   list pr=minAssGTZ(E+P);
+   list sr=minAssGTZ(J+P);
+   i=0;
+   Q=1;
+   list qr;
+
+   while(i<size(pr))
+   {
+      i++;
+      Qstd=std(pr[i]);
+      Zred=simplify(reduce(Zstd,Qstd),2);
+      if(size(Zred)==0)
+      {
+        qr[size(qr)+1]=pr[i];
+        pr=delete(pr,i);
+        i--;
+      }
+      else
+      {
+         Q=intersect(Q,pr[i]);
+      }
+   }
+   i=0;
+   while(i<size(sr))
+   {
+      i++;
+      Qstd=std(sr[i]+E);
+      Zred=simplify(reduce(Zstd,Qstd),2);
+      if((size(Zred)!=0)||(dim(Qstd)!=dim(Zstd)))
+      {
+        Q=intersect(Q,sr[i]);
+      }
+   }
+   poly f;
+   for(i=1;i<=size(Q);i++)
+   {
+      f=Q[i];
+      for(e=1;e<=size(qr);e++)
+      {
+         if(reduce(f,std(qr[e]))==0){f=0;break;}
+      }
+      for(j=1;j<=size(notE);j++)
+      {
+         if(reduce(f,notE[j])==0){f=0; break;}
+      }
+      if(f!=0) break;
+   }
+   i=0;
+   while(f==0)
+   {
+      i++;
+      f=randomid(Q)[1];
+      for(e=1;e<=size(qr);e++)
+      {
+         if(reduce(f,std(qr[e]))==0){f=0;break;}
+      }
+      for(j=1;j<=size(notE);j++)
+      {
+         if(reduce(f,notE[j])==0){f=0; break;}
+      }
+      if(f!=0) break;
+      if(i>20)
+      {
+         ~;
+         ERROR("findTrans:Hier ist was faul");
+      }
+   }
+
+   list resu=P,f;
+   return(resu);
+}
+/////////////////////////////////////////////////////////////////////////////
+static
+proc compareE(list L, int m, int o, list DivL)
+"Internal procedure - no help and no example available
+"
+{
+//----------------------------------------------------------------------------
+// We want to compare the divisors BO[4][size(BO[4])] of the rings
+// L[2][m] and L[2][o].
+// In the initialization step, we collect all necessary data from those
+// those rings. In particular, we determine at what point (in the resolution
+// history) the branches for L[2][m] and L[2][o] were separated, denoting
+// the corresponding ring indices by mPa, oPa and comPa.
+//----------------------------------------------------------------------------
+   def R=basering;
+   int i,j,k,len;
+
+//-- find direct parents and branching point in resolution history
+   matrix tpm=imap(L[2][m],path);
+   matrix tpo=imap(L[2][o],path);
+   int m1,o1=int(leadcoef(tpm[1,ncols(tpm)])),
+             int(leadcoef(tpo[1,ncols(tpo)]));
+   while((i<ncols(tpo)) && (i<ncols(tpm)))
+   {
+     if(tpm[1,i+1]!=tpo[1,i+1]) break;
+     i++;
+   }
+   int branchpos=i;
+   int comPa=int(leadcoef(tpm[1,branchpos]));  // last common ancestor
+//----------------------------------------------------------------------------
+// simple checks to save us some work in obvious cases
+//----------------------------------------------------------------------------
+   if((comPa==m1)||(comPa==o1))
+   {
+//--- one is in the history of the other ==> they cannot give rise
+//---                                        to the same divisor
+      return(0);
+   }
+   def T=L[2][o1];
+   setring T;
+   int dimCo1=dim(std(cent+BO[1]));
+   def S=L[2][m1];
+   setring S;
+   int dimCm1=dim(std(cent+BO[1]));
+   if(dimCm1!=dimCo1)
+   {
+//--- centers do not have same dimension ==> they cannot give rise
+//---                                        to the same divisor
+      return(0);
+   }
+//----------------------------------------------------------------------------
+// fetch the center via the tree for comparison
+//----------------------------------------------------------------------------
+   if(defined(invLocus0)) {kill invLocus0;}
+   ideal invLocus0=fetchInTree(L,o1,comPa,m1,"cent",DivL);
+             // blow down from L[2][o1] to L[2][comPa] and then up to L[2][m1]
+   if(deg(std(invLocus0+invCenter[1]+BO[1])[1])!=0)
+   {
+     setring R;
+     return(int(1));
+   }
+   if(size(BO)>9)
+   {
+     for(i=1;i<=size(BO[10]);i++)
+     {
+       if(deg(std(invLocus0+BO[10][i][1]+BO[1])[1])!=0)
+       {
+         if(dim(std(BO[10][i][1]+BO[1])) >
+              dim(std(invLocus0+BO[10][i][1]+BO[1])))
+         {
+           ERROR("Internal Error: Please send this example to the authors.");
+         }
+         setring R;
+         return(int(2));
+       }
+     }
+   }
+   setring R;
+   return(int(0));
+//----------------------------------------------------------------------------
+// Return-Values:
+//        TRUE (=1) if the exceptional divisors coincide,
+//        TRUE (=2) if the exceptional divisors originate from different
+//                  components of the same center
+//        FALSE (=0) otherwise
+//----------------------------------------------------------------------------
+}
+//////////////////////////////////////////////////////////////////////////////
+
+proc fetchInTree(list L,
+                 int o1,
+                 int comPa,
+                 int m1,
+                 string idname,
+                 list DivL,
+                 list #);
+"Internal procedure - no help and no example available
+"
+{
+//----------------------------------------------------------------------------
+// Initialization and Sanity Checks
+//----------------------------------------------------------------------------
+   int i,j,k,m,branchPos,inJ,exception;
+   string algext;
+//--- we need to be in L[2][m1]
+   def R=basering;
+   ideal test_for_the_same_ring=-77;
+   def Sm1=L[2][m1];
+   setring Sm1;
+   if(!defined(test_for_the_same_ring))
+   {
+//--- we are not in L[2][m1]
+      ERROR("basering has to coincide with L[2][m1]");
+   }
+   else
+   {
+//--- we are in L[2][m1]
+      kill test_for_the_same_ring;
+   }
+//--- non-embedded case?
+   if(size(#)>0)
+   {
+      inJ=1;
+   }
+//--- do parameter values make sense?
+   if(comPa<1)
+   {
+     ERROR("Common Parent should at least be the first ring!");
+   }
+//--- do we need to pass to an algebraic field extension of Q?
+   if(typeof(attrib(idname,"algext"))=="string")
+   {
+      algext=attrib(idname,"algext");
+   }
+//--- check wheter comPa is in the history of m1
+//--- same test for o1 can be done later on (on the fly)
+   if(m1==comPa)
+   {
+      j=1;
+      i=ncols(path)+1;
+   }
+   else
+   {
+      for(i=1;i<=ncols(path);i++)
+      {
+        if(int(leadcoef(path[1,i]))==comPa)
+        {
+//--- comPa occurs in the history
+           j=1;
+           break;
+        }
+      }
+   }
+   branchPos=i;
+   if(j==0)
+   {
+     ERROR("L[2][comPa] not in history of L[2][m1]!");
+   }
+//----------------------------------------------------------------------------
+// Blow down ideal "idname" from L[2][o1] to L[2][comPa], where the latter
+// is assumed to be the common parent of L[2][o1] and L[2][m1]
+//----------------------------------------------------------------------------
+   if(size(algext)>0)
+   {
+      if(defined(tstr)){kill tstr;}
+      string tstr="ring So1=(0,t),("+varstr(L[2][o1])+"),("+ordstr(L[2][o1])+");";
+      execute(tstr);
+      setring So1;
+      execute(algext);
+      minpoly=leadcoef(p);
+      if(defined(id1)) { kill id1; }
+      if(defined(id2)) { kill id2; }
+      if(defined(idlist)) { kill idlist; }
+      execute("int bool2=defined("+idname+");");
+      if(bool2==0)
+      {
+        execute("list ttlist=imap(L[2][o1],"+idname+");");
+      }
+      else
+      {
+        execute("list ttlist="+idname+";");
+      }
+      kill bool2;
+      def BO=imap(L[2][o1],BO);
+      def path=imap(L[2][o1],path);
+      def lastMap=imap(L[2][o1],lastMap);
+      ideal id2=1;
+      if(defined(notE)){kill notE;}
+      list notE;
+      intvec nE;
+      list idlist;
+      for(i=1;i<=size(ttlist);i++)
+      {
+         if((i==size(ttlist))&&(typeof(ttlist[i])!="string")) break;
+         execute("ideal tid="+ttlist[i]+";");
+         idlist[i]=list(tid,ideal(1),nE);
+         kill tid;
+      }
+   }
+   else
+   {
+      def So1=L[2][o1];
+      setring So1;
+      if(defined(id1)) { kill id1; }
+      if(defined(id2)) { kill id2; }
+      if(defined(idlist)) { kill idlist; }
+      execute("ideal id1="+idname+";");
+      if(deg(std(id1)[1])==0)
+      {
+//--- problems with findTrans if id1 is empty set
+//!!! todo: also correct in if branch!!!
+         setring R;
+         return(ideal(1));
+      }
+     // id1=radical(id1);
+
+      ideal id2=1;
+      list idlist;
+      if(defined(notE)){kill notE;}
+      list notE;
+      intvec nE;
+      idlist[1]=list(id1,id2,nE);
+   }
+   if(defined(tli)){kill tli;}
+   list tli;
+   if(defined(id1)) { kill id1; }
+   if(defined(id2)) { kill id2; }
+   ideal id1;
+   ideal id2;
+   if(defined(Etemp)){kill Etemp;}
+   ideal Etemp;
+   for(m=1;m<=size(idlist);m++)
+   {
+      id1=idlist[m][1];
+      id2=idlist[m][2];
+      nE=idlist[m][3];
+      for(i=branchPos-1;i<=size(BO[4]);i++)
+      {
+        if(size(reduce(BO[4][i],std(id1+BO[1])))==0)
+        {
+           if(size(reduce(id1,std(BO[4][i])))!=0)
+           {
+             Etemp=BO[4][i];
+             if(npars(basering)>0)
+             {
+                if(defined(prtemp)){kill prtemp;}
+                list prtemp=minAssGTZ(BO[4][i]);
+                if(size(prtemp)>1)
+                {
+                  Etemp=ideal(1);
+                  for(j=1;j<=size(prtemp);j++)
+                  {
+                     if(size(reduce(prtemp[j],std(id1)))==0)
+                     {
+                        Etemp=prtemp[j];
+                        break;
+                     }
+                  }
+                  if(deg(std(Etemp)[1])==0)
+                  {
+                    ERROR("fetchInTree:something wrong in field extension");
+                  }
+                }
+             }
+             if(inJ)
+             {
+                tli=findTrans(id1+BO[2],Etemp,notE,BO[2]);
+             }
+             else
+             {
+                tli=findTrans(id1,Etemp,notE);
+             }
+           }
+           else
+           {
+             tli[1]=ideal(0);
+             tli[2]=ideal(1);
+           }
+           id1=tli[1];
+           id2=id2*tli[2];
+           notE[size(notE)+1]=BO[4][i];
+           for(j=1;j<=size(DivL);j++)
+           {
+              if(inIVList(intvec(o1,i),DivL[j]))
+              {
+                 nE[size(nE)+1]=j;
+                 break;
+              }
+           }
+           if(size(nE)<size(notE))
+           {
+              ERROR("fetchInTree: divisor not found in divL");
+           }
+        }
+        idlist[m][1]=id1;
+        idlist[m][2]=id2;
+        idlist[m][3]=nE;
+      }
+   }
+   if(o1>1)
+   {
+      while(int(leadcoef(path[1,ncols(path)]))>=comPa)
+      {
+         if((int(leadcoef(path[1,ncols(path)]))>comPa)&&
+            (int(leadcoef(path[1,ncols(path)-1]))<comPa))
+         {
+            ERROR("L[2][comPa] not in history of L[2][o1]!");
+         }
+         def S=basering;
+         if(int(leadcoef(path[1,ncols(path)]))==1)
+         {
+//--- that's the very first ring!!!
+           int und_jetzt_raus;
+         }
+         if(defined(T)){kill T;}
+         if(size(algext)>0)
+         {
+           if(defined(T0)){kill T0;}
+           def T0=L[2][int(leadcoef(path[1,ncols(path)]))];
+           if(defined(tstr)){kill tstr;}
+           string tstr="ring T=(0,t),("
+                      +varstr(L[2][int(leadcoef(path[1,ncols(path)]))])+"),("
+                      +ordstr(L[2][int(leadcoef(path[1,ncols(path)]))])+");";
+           execute(tstr);
+           setring T;
+           execute(algext);
+           minpoly=leadcoef(p);
+           kill tstr;
+           def BO=imap(T0,BO);
+           if(!defined(und_jetzt_raus))
+           {
+              def path=imap(T0,path);
+              def lastMap=imap(T0,lastMap);
+           }
+           if(defined(idlist)){kill idlist;}
+           list idlist=list(list(ideal(1),ideal(1)));
+         }
+         else
+         {
+           def T=L[2][int(leadcoef(path[1,ncols(path)]))];
+           setring T;
+           if(defined(id1)) { kill id1; }
+           if(defined(id2)) { kill id2; }
+           if(defined(idlist)){kill idlist;}
+           list idlist=list(list(ideal(1),ideal(1)));
+         }
+         setring S;
+         if(defined(phi)) { kill phi; }
+         map phi=T,lastMap;
+         for(m=1;m<=size(idlist);m++)
+         {
+            if(defined(id1)){kill id1;}
+            if(defined(id2)){kill id2;}
+            ideal id1=idlist[m][1]+BO[1];
+            ideal id2=idlist[m][2]+BO[1];
+            nE=idlist[m][3];
+            setring T;
+            ideal id1=preimage(S,phi,id1);
+            ideal id2=preimage(S,phi,id2);
+            idlist[m]=list(id1,id2,nE);
+            kill id1,id2;
+            setring S;
+         }
+         setring T;
+//--- after blowing down we might again be sitting inside a relevant
+//--- exceptional divisor
+         for(m=1;m<=size(idlist);m++)
+         {
+            if(defined(id1)) {kill id1;}
+            if(defined(id2)) {kill id2;}
+            if(defined(notE)) {kill notE;}
+            if(defined(notE)) {kill notE;}
+            list notE;
+            ideal id1=idlist[m][1];
+            ideal id2=idlist[m][2];
+            nE=idlist[m][3];
+            for(i=branchPos-1;i<=size(BO[4]);i++)
+            {
+               if(size(reduce(BO[4][i],std(id1)))==0)
+               {
+                  if(size(reduce(id1,std(BO[4][i])))!=0)
+                  {
+                     if(defined(Etemp)) {kill Etemp;}
+                     ideal Etemp=BO[4][i];
+                     if(npars(basering)>0)
+                     {
+                        if(defined(prtemp)){kill prtemp;}
+                        list prtemp=minAssGTZ(BO[4][i]);
+                        if(size(prtemp)>1)
+                        {
+                           Etemp=ideal(1);
+                           for(j=1;j<=size(prtemp);j++)
+                           {
+                               if(size(reduce(prtemp[j],std(id1)))==0)
+                               {
+                                  Etemp=prtemp[j];
+                                  break;
+                               }
+                           }
+                           if(deg(std(Etemp)[1])==0)
+                           {
+                              ERROR("fetchInTree:something wrong in field extension");
+                           }
+                        }
+                     }
+                     if(defined(tli)) {kill tli;}
+                     if(inJ)
+                     {
+                        def tli=findTrans(id1+BO[2],Etemp,notE,BO[2]);
+                     }
+                     else
+                     {
+                        def tli=findTrans(id1,Etemp,notE);
+                     }
+                  }
+                  else
+                  {
+                     tli[1]=ideal(0);
+                     tli[2]=ideal(1);
+                  }
+                  id1=tli[1];
+                  id2=id2*tli[2];
+                  notE[size(notE)+1]=BO[4][i];
+                  for(j=1;j<=size(DivL);j++)
+                  {
+                     if(inIVList(intvec(o1,i),DivL[j]))
+                     {
+                        nE[size(nE)+1]=j;
+                        break;
+                     }
+                  }
+                  if(size(nE)<size(notE))
+                  {
+                     ERROR("fetchInTree: divisor not found in divL");
+                  }
+               }
+               idlist[m][1]=id1;
+               idlist[m][2]=id2;
+               idlist[m][3]=nE;
+            }
+         }
+         kill S;
+         if(defined(und_jetzt_raus))
+         {
+           kill und_jetzt_raus;
+           break;
+         }
+      }
+   }
+//----------------------------------------------------------------------------
+// Blow up ideal id1 from L[2][comPa] to L[2][m1]. To this end, first
+// determine the path to follow and save it in path_togo.
+//----------------------------------------------------------------------------
+   if(m1==comPa)
+   {
+      if(size(algext)==0)
+      {
+        return(idlist[1][1]);
+      }
+      else
+      {
+        list retlist;
+        for(m=1;m<=size(idlist);m++)
+        {
+          retlist[m]=string(idlist[m][1]);
+        }
+        return(retlist);
+      }
+   }
+   if(defined(path_m1)) { kill path_m1; }
+   matrix path_m1=imap(Sm1,path);
+   intvec path_togo;
+   for(i=1;i<=ncols(path_m1);i++)
+   {
+      if(path_m1[1,i]>=comPa)
+      {
+        path_togo=path_togo,int(leadcoef(path_m1[1,i]));
+      }
+   }
+   path_togo=path_togo[2..size(path_togo)],m1;
+   i=1;
+   while(i<size(path_togo))
+   {
+      def S=basering;
+      if(defined(T)){kill T;}
+      if(size(algext)>0)
+      {
+         if(defined(T0)){kill T0;}
+         def T0=L[2][path_togo[i+1]];
+         if(defined(tstr)){kill tstr;}
+         string tstr="ring T=(0,t),(" +varstr(T0)+"),(" +ordstr(T0)+");";
+         execute(tstr);
+         setring T;
+         execute(algext);
+         minpoly=leadcoef(p);
+         kill tstr;
+         def path=imap(T0,path);
+         def BO=imap(T0,BO);
+         def lastMap=imap(T0,lastMap);
+         if(defined(phi)){kill phi;}
+         map phi=S,lastMap;
+         list idlist=phi(idlist);
+      }
+      else
+      {
+         def T=L[2][path_togo[i+1]];
+         setring T;
+         if(defined(phi)) { kill phi; }
+         map phi=S,lastMap;
+         if(defined(idlist)) {kill idlist;}
+         list idlist=phi(idlist);
+         idlist[1][1]=radical(idlist[1][1]);
+         idlist[1][2]=radical(idlist[1][2]);
+      }
+      for(m=1;m<=size(idlist);m++)
+      {
+         idlist[m][1]=sat(idlist[m][1]+BO[1],BO[4][size(BO[4])])[1];
+         idlist[m][2]=sat(idlist[m][2],BO[4][size(BO[4])])[1];
+      }
+      if((size(algext)==0)&&(deg(std(idlist[1][1])[1])==0))
+      {
+//--- strict transform empty in this chart, it will stay empty till the end
+         setring Sm1;
+         return(ideal(1));
+      }
+      kill S;
+      i++;
+   }
+   ideal E,bla;
+   intvec kv;
+   list retlist;
+   for(m=1;m<=size(idlist);m++)
+   {
+      for(j=2;j<=size(idlist[m][3]);j++)
+      {
+         kv=findInIVList(1,path_togo[size(path_togo)],DivL[idlist[m][3][j]]);
+         if(kv!=intvec(0))
+         {
+           E=E+BO[4][kv[2]];
+         }
+      }
+      bla=quotient(idlist[m][1]+E,idlist[m][2]);
+      retlist[m]=string(bla);
+   }
+   if(size(algext)==0)
+   {
+     return(bla);
+   }
+   return(retlist);
+}
+/////////////////////////////////////////////////////////////////////////////
+static
+proc findInIVList(int pos, int val, list ivl)
+"Internal procedure - no help and no example available
+"
+{
+//--- find entry with value val at position pos in list of intvecs
+//--- and return the corresponding entry
+   int i;
+   for(i=1;i<=size(ivl);i++)
+   {
+      if(ivl[i][pos]==val)
+      {
+         return(ivl[i]);
+      }
+   }
+   return(intvec(0));
+}
+/////////////////////////////////////////////////////////////////////////////
+static
+proc inIVList(intvec iv, list li)
+"Internal procedure - no help and no example available
+"
+{
+//--- if intvec iv is contained in list li return 1, 0 otherwise
+  int i;
+  int s=size(iv);
+  for(i=1;i<=size(li);i++)
+  {
+     if(typeof(li[i])!="intvec"){ERROR("Not integer vector in the list");}
+     if(s==size(li[i]))
+     {
+        if(iv==li[i]){return(1);}
+     }
+  }
+  return(0);
+}
+//////////////////////////////////////////////////////////////////////////////
+static
+proc Vielfachheit(ideal J,ideal I)
+"Internal procedure - no help and no example available
+"
+{
+//--- auxilliary procedure for addSelfInter
+//--- compute multiplicity, suitable for the special situation there
+  int d=1;
+  int vd;
+  int c;
+  poly p;
+  ideal Ip,Jp;
+  while((d>0)||(!vd))
+  {
+     p=randomLast(100)[nvars(basering)];
+     Ip=std(I+ideal(p));
+     c++;
+     if(c>20){ERROR("Vielfachheit: Dimension is wrong");}
+     d=dim(Ip);
+     vd=vdim(Ip);
+  }
+  Jp=std(J+ideal(p));
+  return(vdim(Jp)/vdim(Ip));
+}
+/////////////////////////////////////////////////////////////////////////////
+static
+proc genus_E(list re, list iden0, intvec Eindex)
+"Internal procedure - no help and no example available
+"
+{
+   int i,ge,gel,num;
+   def R=basering;
+   ring Rhelp=0,@t,dp;
+   def S=re[2][Eindex[1]];
+   setring S;
+   def Sh=S+Rhelp;
+//----------------------------------------------------------------------------
+//--- The Q-component X is reducible over C, decomposes into s=num components
+//--- X_i, we assume they have n.c.
+//---           s*g(X_i)=g(X)+s-1.
+//----------------------------------------------------------------------------
+   if(defined(I2)){kill I2;}
+   ideal I2=dcE[Eindex[2]][Eindex[3]][1];
+   num=ncols(dcE[Eindex[2]][Eindex[3]][4]);
+   setring Sh;
+   if(defined(I2)){kill I2;}
+   ideal I2=imap(S,I2);
+   I2=homog(I2,@t);
+   ge=genus(I2);
+   gel=(ge+(num-1))/num;
+   if(gel*num-ge-num+1!=0){ERROR("genus_E: not divisible by num");}
+   setring R;
+   return(gel,num);
+}
+
