##
##    Title:    traubjen
##    Created:   Thu Nov 10 10:47:46 1988
##    Author:    Salvy Bruno
##      <salvy@poly>
##
##  Traub-Jenkins algorithm for complex polynomials, and its specialization
## for real polynomials.
##  See also:
##    M.A. Jenkins and J.F. Traub
##     A three-stage variable-shift iteration for polynomial zeros and 
##     its relation to generalized Rayleigh iteration.
##          Numer.Math. 44, 252--263 (1970)
##   and
##    M.A. Jenkins and J.F. Traub
##     A three-stage variable-shift iteration for real polynomials using
##     quadratic iteration.
##          SIAM J. Numer. Anal. vol7, no4, dec 1970, 545--566.
##
##  To make it fast, it is necessary not to use evalc, hence the
## functions `traubjen/subs`,`traubjen/polcompl`, `traubjen/inv`,...

traubjen:=proc (P)
local x, oldDigits, mult;
   indets(P,name) minus {constants};
   if nops(")>1 then
      ERROR(`Wrong number of variables in`,P)
   elif nops(")=0 then
      RETURN([])
   else
      x:=op(")
   fi;
   # remove the zeros at the origin if any
   oldDigits:=Digits;
   expand(evalf(evalc(P)));
   mult:=ldegree(",x);
   expand(evalc(""/x^"));
   Digits:=max(6,Digits+2);
   if type("",polynom) then
      if not has("",I) then
         traperror(`traubjen/real`("",x));
         if "=lasterror then
            traperror(`traubjen/complex`(""",x))
         else "
         fi
      else
         traperror(`traubjen/complex`("",x))
      fi
   else
      Digits:=oldDigits;
      ERROR(`Invalid polynomial`,P)
   fi;
   if "=lasterror then
      Digits:=oldDigits;
      ERROR("")
   fi;
   Digits:=oldDigits;
   evalf([0$mult,op("")])
end: #traubjen


`traubjen/complex`:=proc(P,x)
local deg, p, alreadyfound, cnt, h, res, s, a, b, rotation, modul;
   res:=[];
   # scale the polynomial
   p:=`traubjen/polcompl`(P,`traubjen/inv`(lcoeff(P,x)));
   deg:=degree(p,x);
   modul:=0;
   rotation:=1;
   while deg>2 do
      # Stage 1: No-shift process
      h:=`traubjen/noshift`(p,x);
      # inner loop to select a shift
      modul:=`traubjen/cauchy`(p,x,deg);
      alreadyfound:=nops(res);
      for cnt to 20 while nops(res)=alreadyfound do
         # Stage 2: Fixed-Shift process
         # rotate by 94 degrees
         rotation:=subs(I**2=-1,expand(rotation*(-.069+I*.997)));
         s:=modul*rotation;
         res:=[op(res),op(`traubjen/fixedshift`(p,s,h,x,false,1,10*cnt))];
      od;
      # admit failure, but this should never happen!
      if nops(res)=alreadyfound then ERROR(`solutions lost`) fi;
      # deflate polynomial
      p:=`traubjen/deflate`(p,res[nops(res)],x);
      deg:=deg-1
   od;
   degree(p,x);
   if "=2 then
      a:=coeff(p,x,2);
      b:=coeff(p,x,1);
      coeff(p,x,0);
      expand(""*""-4*"""*");
      coeff(",I,0);coeff("",I,1);
      sqrt(""^2+"^2);
      ("/2+"""/2)^(1/2)+I*signum("")*("/2-"""/2)^(1/2);
      `traubjen/inv`(a);
      res:=[op(res),expand((-b+"")/2*"),expand((-b-"")/2*")]
   elif "=1 then
      res:=[op(res),expand(-coeff(p,x,0)*`traubjen/inv`(coeff(p,x,1)))]
   fi;
   res
end: # traubjen/complex

`traubjen/real`:=proc(P,x)
local deg, p, alreadyfound, cnt, k, res, a, b, modul, si, sr, pof0,
rotationx, rotationy, pprof0;
   res:=[];
   # scale the polynomial
   p:=P/lcoeff(P,x);
   modul:=0;
   deg:=degree(p,x);
   rotationx:=.707;rotationy:=-.707;
   while deg>2 do
      pof0:=coeff(p,x,0);
      pprof0:=coeff(p,x,1);
      # Stage 1: No-shift process
      diff(p,x)/deg;
      to 5 do
         coeff(",x,0);
         if abs(")<=abs(pprof0)*Float(1,-Digits+2) then
            subs(x^(-1)=0,expand(""/x))
         else
            subs(x^(-1)=0,expand((p-pof0/"*"")/x))
         fi
      od;
      k:=";
      # inner loop to select a shift
      modul:=`traubjen/cauchy`(p,x,deg);
      alreadyfound:=nops(res);
      for cnt to 8 while nops(res)=alreadyfound do
      # Stage 2: Fixed-Shift process
         # rotate by 94 degrees
         rotationx;
         rotationx:=-.0697*rotationx-.997*rotationy;
         rotationy:=-.0697*rotationy+.997*"";
         sr:=modul*rotationx;
         si:=modul*rotationy;
         `traubjen/fixedshiftr`(p,sr,si,k,x,20*cnt,pof0);
         if nops(")=1 then
            res:=[op(res),op(")];
            p:=`traubjen/deflater`(p,op(""),x);
            deg:=deg-1
         elif nops(")=4 then
            `traubjen/divquad`(p,op(1,"),op(2,"),'p','a','b',x);
            res:=[op(res),op(3,""),op(4,"")];
            deg:=deg-2
         fi
      od;
      if nops(res)=alreadyfound then ERROR(`Solutions lost`) fi
   od;
   degree(p,x);
   if "=2 then
      a:=coeff(p,x,2);
      b:=coeff(p,x,1);
      coeff(p,x,0);
      ""*""-4*"""*";
      if ">=0 then "^(1/2) else I*(-")^(1/2) fi;
      res:=[op(res),(-b-")/2/a,(-b+")/2/a]
   elif "=1 then
      res:=[op(res),-coeff(p,x,0)/coeff(p,x,1)]
   fi;
   res
end: # traubjen/real

`traubjen/noshift`:=proc (p,x)
local const;
   # Stage 1: No-shift process
   const:=`traubjen/inv`(coeff(p,x,0));
   diff(p,x);
   to 5 do
      subs(x^(-1)=0,expand(("-`traubjen/polcompl`(p,
         expand(coeff(",x,0)*const)))/x))
   od
end: # `traubjen/noshift`

`traubjen/fixedshift`:=proc (p,s,k,x,donttry,i0,imax)
local pofs, invpofs, h, t, finished, normp, i, hofs;
   # Stage 2: Fixed-Shift process
   pofs:=`traubjen/subs`(p,s,x);
   invpofs:=`traubjen/inv`(");
   normp:=`traubjen/polcompl`(p,invpofs);
   h:=k;
   if donttry then
      for i from i0 to imax do
         `traubjen/deflate`("-`traubjen/polcompl`(normp,
            `traubjen/subs`(",s,x)),s,x)
      od;
      h:="
   else
      hofs:=`traubjen/subs`(h,s,x);
      s;
      false;
      for i from i0 to imax while not (" and finished) do
         t:="";
         finished:="";
         h:=`traubjen/deflate`(h-`traubjen/polcompl`(normp,hofs),s,x);
         hofs:=`traubjen/subs`(",s,x);
         s-expand(pofs*expand(lcoeff("",x)*`traubjen/inv`(")));
         evalb(i>i0 and 4*`traubjen/sqrabs`("-t)<=`traubjen/sqrabs`(t))
      od;
   fi;
   if not donttry and i=imax+1 then
      []
   else
      if donttry then
         `traubjen/varshift`(p,h,s,x)
      else
         `traubjen/varshift`(p,h,"",x)
      fi;
      if "=[] and not donttry then
         `traubjen/fixedshift`(p,s,h,x,true,i,imax)
      else
         "
      fi;
   fi
end: # `traubjen/fixedshift`

`traubjen/fixedshiftr`:=proc (p,sr,si,h,x,imax,pof0)
local k, t, linearfact, quadrat, qp, a, b, i, a1, a2, a3, b1l, b2l, c, c1, c2,
c3, c4, d, pprof0, prevvl, prevt, qk, u, v, ul, vl, betas, betav, quadp, linp,
   donttry;
   u:=-2*sr;
   v:=sr*sr+si*si;
   `traubjen/divquad`(p,u,v,'qp','a','b',x);
   linearfact:=1;
   quadrat:=1;
   betav:=.25;
   betas:=.25;
   pprof0:=coeff(p,x,1);
   k:=h;
   `traubjen/divquad`(k,u,v,'qk','c','d',x);
   if abs(c)<=abs(coeff(k,x,0))*Float(1,-Digits+2) or 
      abs(d)<=abs(coeff(k,x,1))*Float(1,-Digits+2) then
      ul:=0;vl:=0;donttry:=true
   else
      ul:=u;vl:=v;donttry:=false
   fi;
   for i to imax do
      if donttry then
         k:=qk
      else
         b*c-a*d;
         k:=(a*a+u*a*b+v*b*b)/"*qk+expand((x-(a*c+u*a*d+v*b*d)/")*qp)+b
      fi;
      `traubjen/divquad`(k,u,v,'qk','c','d',x);
      if abs(c)<=abs(coeff(k,x,0))*Float(1,-Digits+2) or 
         abs(d)<=abs(coeff(k,x,1))*Float(1,-Digits+2) then
         ul:=0;vl:=0;donttry:=true
      else
         donttry:=false;
         b1l:=-coeff(k,x,0)/pof0;
         b2l:=-(coeff(k,x,1)+b1l*pprof0)/pof0;
         a1:=b*c-a*d;
         a2:=a*c+u*a*d+v*b*d;
         a3:=a*a+u*a*b+v*b*b;
         c2:=b1l*a2;
         c3:=b1l*b1l*a3;
         c4:=v*b2l*a1-c2-c3;
         c1:=c*c+u*c*d+v*d*d+b1l*(a*c+u*b*c+v*b*d)-c4;
         if c1=0 then
            ul:=0;
            vl:=0
         else
            ul:=u-(u*(c2+c3)+v*(b1l*a1+b2l*a2))/c1;
            vl:=v+v*c4/c1
         fi
      fi;
      if coeff(k,x,0)=0 then
         t:=0
      else
         t:=1/b1l
      fi;
      if i>1 and not donttry then
         if vl<>0 then
            abs((vl-prevvl)/vl);
            if "<quadrat then
               quadp:="*quadrat;
            else
               quadp:=1
            fi;
            quadrat:=""
         else
            quadp:=1;
            quadrat:=1
         fi;
         if t<>0 then
            abs((t-prevt)/t);
            if "<linearfact then
               linp:="*linearfact
            else
               linp:=1
            fi;
            linearfact:=""
         else
            linp:=1;
            linearfact:=1
         fi;
         if quadp<betav or linp<betas then
            if linp<=quadp then
               `traubjen/realit`(t,p,x,k,pof0);
               if nops(")<>0 then RETURN(")
               else betas:=betas*.25
               fi
            fi;
            if quadp<betav then
               `traubjen/quadit`(ul,vl,p,x,pof0,k);
               if nops(")<>0 then RETURN(")
               else betav:=betav*.25
               fi
            fi;
            if linp<betas and linp>=quadp then
               `traubjen/realit`(t,p,x,k,pof0);
               if nops(")<>0 then RETURN(")
               else betas:=betas*.25
               fi
            fi
         fi
      fi;
      prevt:=t;
      prevvl:=vl
   od;
   []
end: # `traubjen/fixedshiftr`

`traubjen/varshift`:=proc (p,oldh,olds,x)
local s, h, pofs, error, abspofs;
   # Stage three: variable-shift
   s:=olds;
   pofs:=`traubjen/subsanderror`(p,s,x,'error');
   abspofs:=`traubjen/sqrabs`(");
   if 400*error>=" then RETURN([s]) fi;
   h:=oldh;
   to 10 do
      h:=`traubjen/deflate`(h-`traubjen/polcompl`(p,expand(
            `traubjen/subs`(h,s,x)*`traubjen/inv`(pofs))),s,x);
      s-expand(lcoeff(",x)*expand(
         pofs*`traubjen/inv`(`traubjen/subs`(",s,x))));
      `traubjen/subs`(p,",x);
      `traubjen/sqrabs`(");
      if 400*error>=" then
         RETURN(["""])
      elif ">100*abspofs then
         RETURN([])
      else
         s:=""";
         pofs:=""";
         abspofs:="""
      fi
   od;
   [];
end: # `traubjen/varshift`

#    deflate a by x-s

`traubjen/deflate` := proc(a,s,x)
local j;
   0;
   0;
   for j from degree(a,x)-1 by -1 to 0 do
      expand(""*s)+coeff(a,x,j+1);
      ""+x^j*"
   od;
   "
end: # `traubjen/deflate`

`traubjen/sqrabs`:=proc (x)
   coeff(x,I,0)^2+coeff(x,I,1)^2
end: # `traubjen/sqrabs`

`traubjen/deflater` := proc(a,s,x)
local j;
   0;
   0;
   for j from degree(a,x)-1 by -1 to 0 do
      ""*s+coeff(a,x,j+1);
      ""+x^j*"
   od;
   "
end: # `traubjen/deflater`

`traubjen/cauchy`:=proc (p,x,deg)
local i, abspol, oldd, a, b, f; #,diffabspol
   oldd:=Digits;
   Digits:=4;
   # Compute a lower bound on the moduli of the roots:
   # it is the smallest positive root of abspol
   0;
   for i to deg do
      `traubjen/sqrabs`(coeff(p,x,i))^(1/2)*x^i+"
   od;
   abspol:=`traubjen/abspol`(p,x,deg);
   # find a good first value:
   (-coeff(abspol,x,0)/coeff(abspol,x,deg))^(1/deg);
   if coeff(p,x,1)=0 then
      "
   else
      min(",-coeff(abspol,x,0)/coeff(abspol,x,1))
   fi;
   while subs(x=",abspol)>0 do "/10 od;
   # for polynomials, the secant method is faster than Newton's:
   f:=subs(x=",abspol);
   a:="";
   b:="*10;
   while abs(""-")>.005*abs(") do
      f;
      f:=subs(x="",abspol);
      (a*"-"""*"")/("-"");
      a:=b;
      b:=""
   od;
   Digits:=oldd;
   b
end: # `traubjen/cauchy`

`traubjen/abspol`:=proc(p,x,deg)
local i;
   if has(p,I) then
      0;
      for i to deg do
         `traubjen/sqrabs`(coeff(p,x,i))^(1/2)*x^i+"
      od;
      "-`traubjen/sqrabs`(coeff(p,x,0))^(1/2);
   else
      0;
      for i to deg do
         abs(coeff(p,x,i))*x^i+"
      od;
      "-abs(coeff(p,x,0))
   fi
end: # `traubjen/abspol`

`traubjen/subs`:=proc(pol,val,x)
local i;
   degree(pol,x);
   coeff(pol,x,");
   for i from ""-1 by -1 to 0 do
      expand("*val)+coeff(pol,x,i)
   od;
   "
end: # `traubjen/subs`

`traubjen/subsr`:=proc(pol,val,x)
local i;
   0;
   for i from degree(pol,x) by -1 to 0 do
      "*val+coeff(pol,x,i)
   od;
   "
end: # `traubjen/subsr`

`traubjen/subsanderror`:=proc(pol,val,x,err)
local i, deg, a, q, oldd;
   deg:=degree(pol,x);
   0;
   for i from deg by -1 to 0 do
      q[i]:=expand("*val)+coeff(pol,x,i);
   od;
   oldd:=Digits;
   Digits:=6;
   a:=`traubjen/sqrabs`(val)^(1/2);
   0;
   for i from deg by -1 to 1 do
      "*a+`traubjen/sqrabs`(q[i])^(1/2)
   od;
   err:=("*a)^2*Float(1,-2*oldd);
   Digits:=oldd;
   q[0]
end: # `traubjen/subsanderror`

`traubjen/subsanderrorr`:=proc(pol,val,x,err)
local i, deg, a, q, oldd;
   deg:=degree(pol,x);
   0;
   for i from deg by -1 to 0 do
      q[i]:="*val+coeff(pol,x,i);
   od;
   oldd:=Digits;
   Digits:=6;
   a:=abs(val);
   0;
   for i from deg by -1 to 1 do
      "*a+abs(q[i])
   od;
   err:=("*a)^2*Float(1,-2*oldd);
   Digits:=oldd;
   q[0]
end: # `traubjen/subsanderrorr`

`traubjen/subsranderrorr`:=proc(pol,val,quot,x,err)
local i, deg, a, res1, res2;
   deg:=degree(pol,x);
   0;
   for i from deg by -1 to 0 do
      "*val+coeff(pol,x,i)
   od;
   res1:=";
   Digits:=Digits+4;
   0;
   0;
   for i from deg by -1 to 1 do
      ""*val+coeff(pol,x,i);
      ""+"*x^(i-1)
   od;
   res2:=""*val+coeff(pol,x,0);
   quot:="";
   err:=abs(res2-res1);
   Digits:=Digits-4;
   res2
end: # `traubjen/subsranderrorr`

`traubjen/subsranddivide`:=proc(pol,quot,val,x)
local i, deg, q;
   deg:=degree(pol,x);
   0;
   0;
   for i from deg by -1 to 1 do
      q[i]:=""*val+coeff(pol,x,i);
      ""+"*x^(i-1)
   od;
   q[0]:=""*val+coeff(pol,x,i);
   quot:="";
   q[0]
end: # `traubjen/subsranddivide`


`traubjen/polcompl`:=proc (pol,a)
local r;
   expand(pol);
   r:=coeff(",I,0);
   coeff("",I,1);
   coeff(a,I,0);
   coeff(a,I,1);
   ""*r-"""*"+expand(I*("*r+"""*""))
end: # `traubjen/polcompl`

`traubjen/inv`:=proc (aplusib)
   coeff(aplusib,I,0);
   coeff(aplusib,I,1);
   ""**2+"**2;
   """/"-I*""/"
end: # `traubjen/inv`

`traubjen/divquad`:=proc (pol,u,v,quot,a,b,x)
local i;#, deg, q
#   deg:=degree(pol,x);
#   q[deg]:=0;
#   q[deg-1]:=0;
#   res:=0;
#   for i from deg-2 by -1 to 0 do
#      q[i]:=coeff(pol,x,i+2)-u*q[i+1]-v*q[i+2];
#      ""+"*x^i
#   od;
#   quot:=";
#   if deg>0 then
#      b:=coeff(pol,x,1)-u*q[0]-v*q[1]
#   else
#      b:=0
#   fi;
#   a:=coeff(pol,x,0)-v*q[0]-u*"
# the following is about 10% faster than the above:
   0;0;0;
   for i from degree(pol,x)-2 by -2 to 1 do
      coeff(pol,x,i+2)-u*""-v*""";
      coeff(pol,x,i+1)-u*"-v*""";
      """+x^i*""+x^(i-1)*"
   od;
   if i=0 then
      coeff(pol,x,2)-u*""-v*""";
      b:=coeff(pol,x,1)-u*"-v*""";
      quot:="""+"";
      a:=coeff(pol,x,0)-u*""-v*"""
   else
      b:=coeff(pol,x,1)-u*""-v*""";
      a:=coeff(pol,x,0)-u*"-v*""";
      quot:="""
   fi
end: # `traubjen/divquad`

`traubjen/tryc`:=proc (pol,u,v,quot,a,b,mp,x)
local discr, loca, locb, t, locmp, firstlocmp, lquot;
   `traubjen/divquad`(pol,u,v,'lquot','loca','locb',x);
   discr:=u*u-4*v;
   if ">=0 then
      if u>0 then
         (-u+"^(1/2))/2;
         t:=(-u-""^(1/2))/2;
         if -"-abs("")>-""/100 then ERROR(real) fi
      else
         (-u-"^(1/2))/2;
         t:=(-u+""^(1/2))/2;
         if "-abs("")>"/100 then ERROR(real) fi
      fi;
      firstlocmp:=abs(loca-"*locb)
   else
      firstlocmp:=abs(loca+locb*u/2)+abs(locb*(-")^(1/2))
   fi;
   Digits:=Digits+4;
   `traubjen/divquad`(pol,u,v,'lquot','loca','locb',x);
   if discr>=0 then locmp:=abs(loca-t*locb)
   else locmp:=abs(loca+locb*u/2)+abs(locb*(-discr)^(1/2))
   fi;
   Digits:=Digits   -4;
   abs(locmp-firstlocmp);
   if max(locmp,firstlocmp)<=20*" then
      if discr<0 then
         RETURN([u,v,-u/2-I*(-discr)^(1/2)/2,-u/2+I*(-discr)^(1/2)/2])
      else
         RETURN([u,v,-u/2-(discr)^(1/2)/2,-u/2+(discr)^(1/2)/2])
      fi
   fi;
   a:=loca;
   b:=locb;
   mp:=locmp;
   quot:=lquot;
   []
end: # `traubjen/tryc`


`traubjen/realit`:=proc(olds,p,x,oldh,pof0)
local pofs, h, s, i, prevpofs, t, error, qp, qh;
   s:=olds;
   h:=oldh;
   for i to 10 do
      pofs:=`traubjen/subsranderrorr`(p,s,'qp',x,'error');
      if 20*error>=abs(") then RETURN([s])
      elif i>2 and abs(pofs)>abs(prevpofs) and abs(t)<.01*abs(s) then
         RETURN(`traubjen/quadit`(-2*s,s*s,p,x,pof0,oldh))
      elif i>2 and abs(pofs)>10*abs(prevpofs) then
         RETURN([])
      fi;
      `traubjen/subsranddivide`(h,'qh',s,x);
      if abs(")<abs(coeff(h,x,0))*Float(1,-Digits+2) then
         h:=qh
      else
         h:=-pofs/"*qh+qp
      fi;
      `traubjen/subsr`(h,s,x);
      if abs(")>abs(coeff(h,x,0))*Float(1,-Digits+2) then
         t:=-pofs/"
      else
         t:=0
      fi;
      s:=s+t;
      prevpofs:=pofs
   od;
   []
end: # `traubjen/realit`

`traubjen/quadit`:=proc(u,v,p,x,pof0,k)
local ul, vl, kl, qp, qk, a, b, c, d, b1l, b2l, a1, a2, a3, c1, c2, c3, c4, 
pprof0, i, abspofs, mp, cluster, tried, prevvl, donttry;
   ul:=u;
   vl:=v;
   kl:=k;
   tried:=false;
   `traubjen/divquad`(kl,ul,vl,'qk','c','d',x);
   pprof0:=coeff(p,x,1);
   for i to 10 do
      prevvl:=vl;
      traperror(`traubjen/tryc`(p,ul,vl,'qp','a','b','mp',x));
      if "=lasterror then RETURN([])
      elif "<>[] then RETURN(")
      elif i>2 and 10*abspofs<mp then RETURN([])
      elif i>2 and cluster<.01 and mp>abspofs and not tried then
         if cluster<Float(1,-Digits+2) then
            cluster:=Float(1,trunc(-Digits/2))
         else
            cluster:=(cluster)^(1/2)
         fi;
         ul:=ul-ul*cluster;
         vl:=vl+vl*cluster;
         `traubjen/divquad`(p,ul,vl,'qp','a','b',x);
         to 5 do
            `traubjen/divquad`(kl,ul,vl,'qk','c','d',x);
            if abs(c)<=abs(coeff(kl,x,0))*Float(1,-Digits+2) or 
               abs(d)<=abs(coeff(kl,x,1))*Float(1,-Digits+2) then
               donttry:=true
            else
               donttry:=false
            fi;
            if donttry then
               kl:=qk
            else
               b*c-a*d;
               kl:=(a*a+ul*a*b+vl*b*b)/"*qk+
                  expand((x-(a*c+ul*a*d+vl*b*d)/")*qp)+b
            fi
         od;
         tried:=true;
         i:=1
      fi;
      abspofs:=mp;
      `traubjen/divquad`(kl,ul,vl,'qk','c','d',x);
      if abs(c)<=abs(coeff(kl,x,0))*Float(1,-Digits+2) or
         abs(d)<=abs(coeff(kl,x,1))*Float(1,-Digits+2) then
         donttry:=true
      else
         donttry:=false
      fi;
      if donttry then
         kl:=qk
      else
         b*c-a*d;
         kl:=(a*a+ul*a*b+vl*b*b)/"*qk+expand((x-(a*c+ul*a*d+vl*b*d)/")*qp)+b
      fi;
      `traubjen/divquad`(kl,ul,vl,'qk','c','d',x);
      if abs(c)<=abs(coeff(kl,x,1))*Float(1,-Digits+2) then
         ul:=0;
         vl:=0;
         donttry:=true
      else
         donttry:=false;
         b1l:=-subs(x=0,kl)/pof0;
         b2l:=-(coeff(kl,x,1)+b1l*pprof0)/pof0;
         a1:=b*c-a*d;
         a2:=a*c+ul*a*d+vl*b*d;
         a3:=a*a+ul*a*b+vl*b*b;
         c2:=b1l*a2;
         c3:=b1l*b1l*a3;
         c4:=vl*b2l*a1-c2-c3;
         c1:=c*c+ul*c*d+vl*d*d+b1l*(a*c+ul*b*c+vl*b*d)-c4;
         if "=0 then
            ul:=0;
            vl:=0
         else
            ul:=ul-1/c1*(ul*(c2+c3)+vl*(b1l*a1+b2l*a2));
            vl:=vl+vl*c4/c1
         fi
      fi;
      if vl=0 then RETURN([])
      else
         cluster:=abs((prevvl-vl)/vl)
      fi
   od;
   []
end: # `traubjen/quadit`

#save `traubjen.m`;
#quit
