ellipso:=table();

ellipso[quvar]:=proc(m::integer, p)

# 10.10.2003
# This procedure constructs the first order autonomous ODE, which
# solutions tend to infinity as 1/t^p.
# The maximal degree of dy is m.

local k, j, numterm;
numterm:=0;
for k from 0 to m-1
    do for j from 0 while p*j <= (p+1)*(m-k)
       do numterm:=numterm+1;
       od;
    od;
return numterm;
end;



ellipso[equa]:=proc(a, m::integer, p, yp2, dyp2)

# 10.3.2003
# This procedure constructs the first order autonomous ODE, which
# solutions tend to infinity as 1/t^p.
# The maximal degree of dy is m.

local equ, k, j, numterm;
equ:=0;
for k from 0 to m
    do for j from 0 while p*j <= (p+1)*(m-k)
       do equ := equ+a[j,k]*yp2^j*dyp2^k;
       od
    od;
return equ;
end;



ellipso[equalaur]:=proc(a, m::integer, p::integer, Laurentmax::integer)

# 10.10.2003
# This procedure expands the first order polynomial autonomous ODE in
# the Laurent series, including terms from 1/t^Laurentmax to t^Nmax.
# The maximal degree of dy is m.

local max,equ,k,j,y,dy,equlist,t;
equ:=equa(a,m,p,yp,dyp);
y:=0;
for k from -p to Laurentmax-p do y:=y+c(k)*t^k od;
dy:=diff(y,t);
max:=quvar(m,p)+1;
if Laurentmax > max then max:=Laurentmax fi;
for k from 0 to m
  do
    dyp(k):=convert(taylor(eval(dy**k*t^((p+1)*m)),t,max),polynom)
  od;
for k from 0 to iquo(m*(p+1),p)
  do
    yp(k):=convert(taylor(eval(y**k*t^((p+1)*m)),t, max),polynom)
  od;
equlist:=[];
equ:=expand(eval(equ*t^(-(p+1)*m)));
for k from 1 to max
  do
    equlist:=[op(equlist),asubs(t=0,equ)];
    equ:=diff(equ,t)/k;
  od;
return equlist;
end;


ellipso[equalist]:=proc(a, m::integer, p)

# 30.10.2003
# This procedure constructs the first order autonomous ODE is a list.
# solutions tend to infinity as 1/t^p.
# The maximal degree of dy is m.

local fequlist, k, j;
fequlist:=[];
for k from 0 to m
    do for j from 0 while p*j <= (p+1)*(m-k)
       do fequlist:=[op(fequlist),[a[j,k],j,k]];
       od
    od;
return fequlist
end;


ellipso[ydegree]:=proc(c,n,j,p)

# 27.07.2004
# This procedure constructs the j-th term of the Laurent series for y^n;
# solutions tend to infinity as 1/t^p.

local sumy,k,stepp;
if n=1 then return c(j)
   else sumy:=0;
        if p<1 then stepp:=p else stepp:=1 fi;
        for k from -p to j+p*n by stepp
        do sumy:=sumy+c(k)*ydegree(c,n-1,j-k,p);
        od;
        return sumy;
fi;
end;

ellipso[dydegree]:=proc(c,n,j,p)

# 27.07.2004
# This procedure constructs the j-th term of the Laurent series for dy^n;
# solutions tend to infinity as 1/t^p.

local sumdy,k,stepp;
if n=1 then return (j+1)*c(j+1)
   else sumdy:=0;
        if p<1 then stepp:=p else stepp:=1 fi;
        for k from -(p+1) to j+(p+1)*n by stepp
        do sumdy:=sumdy+(k+1)*c(k+1)*dydegree(c,n-1,j-k,p);
        od;
        return sumdy;
fi;
end;


ellipso[monomlaur]:=proc(c,mon,j,p)

# 27.07.2003
# This procedure constructs the Laurent series for mon:=[coef,ydeg,dydeg].
# Solutions tend to infinity as 1/t^p.

local k,coef,ydeg,dydeg,sum,stepp;
coef:=op(1,mon);
ydeg:=op(2,mon);
dydeg:=op(3,mon);
if ydeg=0 then
  if dydeg=0 then
     if j=0 then return coef
     else return 0
     fi;
  else return coef*dydegree(c,dydeg,j,p)
  fi;
else if dydeg=0 then return coef*ydegree(c,ydeg,j,p)
     else sum:=0;
          if p<1 then stepp:=p else stepp:=1 fi;
          for k from -p*ydeg to j+(p+1)*dydeg by stepp
             do sum:=sum+ydegree(c,ydeg,k,p)*dydegree(c,dydeg,j-k,p);
             od;
          return coef*sum;
     fi;
fi;
end;


ellipso[oneequlaur]:=proc(c, fequlist, j, p)

# 27.07.2004
# This procedure constructs the j-th term of the Laurent series of the
# first order autonomous ODE (the list fequlist).
# solutions tend to infinity as 1/t^p.

local equj,k;
equj:=0;
for k from 1 to nops(fequlist)
   do equj:=equj+monomlaur(c,op(k,fequlist),j,p);
   od;
return equj;
end;


ellipso[equlaurlist]:=proc(a,m::integer,p,sernumber::integer,c)

# 27.07.2004
# This procedure constructs the Laurent or Puiseux series of the
# first order autonomous ODE
# with maximal degree of y' is equal to m.
# Solutions tend to infinity as 1/t^p.
# c(k) are the Laurent (Puiseux) series coefficients of y.
# The length of the resulting list is sernumber.

local k, laurlist, fequlist, stepp;
if p<1 then stepp:=p else stepp:=1 fi;
fequlist:=equalist(a,m,p);
for k from -m*(p+1) to -p-stepp by stepp do c(k):=0 od;
laurlist:=[];
for k from -m*(p+1) to (sernumber-1)*stepp-m*(p+1) by stepp do
     laurlist:=[op(laurlist),simplify(oneequlaur(c,fequlist,k,p))] od;
 return laurlist;
end;


ellipso[varlist]:=proc(a,m::integer,p::integer,simlist)

# 25.3.2004
# This procedure gives the list of remaining unknowns a[i,j].

 local k, j, js, len, ad, var;
 len:=nops(simlist);
 var:=[];
 for k from 0 to m-1
    do for j from 0 while p*j <= (p+1)*(m-k)
          do ad:=1;
             for js from 1 to len
                do if k=op([js,3], simlist) and j=op([js,2], simlist)
                      then ad:=0
                   fi;
                od;
             if ad=1 then var:=[op(var),a[j,k]] fi;
          od;
    od;
 return var;
 end;

ellipso[minusimp]:=proc(a,simlist)
local k, j, list3, len, term, ad;
len:=nops(simlist);
list3:=[];
for j from 1 to nops(a)
   do
     term:=op(j,a);
     ad:=1;
     for k from 1 to len
        do
          if op(2,term)=op([k,2],simlist) and op(3,term)=op([k,3],simlist)
             then ad:=0;
          fi;
        od;
     if ad=1 then list3:=[op(list3),term] fi;
   od;
return list3;
end;


ellipso[simplequ]:=proc(m,p)

# This procedure constructs the list of the
# first order autonomous ODE coefficients, which can be exclude from the
# system of algebraic equations.
# The maximal degree of y' is equal to m.
# Solutions tend to infinity as 1/t^p.

local simplist, list2, len, pow, k,j,rr,rr2;
len:=0;
for k from 0 to m-1 do
    for j from 0 while p*j <= (p+1)*(m-k) do
        if len=0 then
                     simplist:=[[-(p*j+(p+1)*k),j,k]];
                     len:=1
                 else
                     list2:=[];
                     pow:=-(p*j+(p+1)*k);
                     for rr from 1 while (rr<=len) and
                           (op([rr,1],simplist)<pow)
                        do list2:=[op(list2),op(rr,simplist)];
                        od;
                     if rr>len or op([rr,1],simplist)>pow
                        then
                          list2:=[op(list2),[-(p*j+(p+1)*k),j,k]];
                          for rr2 from rr while (rr2<=len)
                          do
                            list2:=[op(list2),op(rr2,simplist)];
                          od;
                          simplist:=list2;
                          len:=len+1;
                     fi;
        fi;
    od;
od;
return simplist;
end;

ellipso[simplequ2]:=proc(flist,a,m,p)


# This procedure constructs the list of the
# first order autonomous ODE coefficients, which can be exclude from the
# system of algebraic equations.
# The maximal degree of y' is equal to m.
# Solutions tend to infinity as 1/t^p.

local simplist, list2, len, pow, k,j,rr,rr2;
print(flist);
len:=0;
for k from 0 to m-1 do
    for j from 0 while p*j <= (p+1)*(m-k) do
        if member([a[j,k],j,k],flist)
           then if len=0
                  then
                      simplist:=[[-(p*j+(p+1)*k),j,k]];
                      len:=1
                  else
                     list2:=[];
                     pow:=-(p*j+(p+1)*k);
                     for rr from 1 while (rr<=len) and
                           (op([rr,1],simplist)<pow)
                        do list2:=[op(list2),op(rr,simplist)];
                        od;
                     if (rr>len) or (op([rr,1],simplist)>pow)
                        then
                          list2:=[op(list2),[-(p*j+(p+1)*k),j,k]];
                          for rr2 from rr while (rr2<=len)
                          do
                            list2:=[op(list2),op(rr2,simplist)];
                          od;
                          simplist:=list2;
                          len:=len+1;
                     fi;
               fi;
       fi;
    od;
od;
return simplist;
end;

ellipso[avoida]:=proc(res,resgroeb,var)

local k,j,res2,dft,dfrg,term;
res2:=[];
for j from 1 to nops(res)
 do
   term:=op(j,res);
   for k from 1 to nops(var)
    do
      dft:=diff(term,op(k,var));
      dfrg:=diff(op(k,resgroeb),op(k,var));
      if(dft*dfrg) <> 0 then term:=simplify(dft*op(k,resgroeb)-dfrg*term);
      fi;
    od;
 res2:=[op(res2),term];
 od;
return res2;
end;

ellipso[monomresidue]:=proc(c,fdeg::integer,dfdeg::integer,p::integer)

# This procedure calculates the residue of the product
# f(t)^fdeg*diff(f(t),t)^dfdeg.
# c(k) are the coefficients of the Laurent series for
# the function f(t), which tends to infinity as 1/t^p.

local k,mon;
for k from -p*fdeg-(p+1)*dfdeg to -p-1 do c(k):=0 od;
mon:=[1,fdeg,dfdeg];
return monomlaur(c,mon,-1,p);
end;