###################
# fcnF for Maple6
###################

amT:=proc();
  print(`A curve over Q(T) must be entered using Ell or ell with field \
label K_=T --- see Menu(ell).`);
end:

TesT:=proc() local t;global iee;
  if not type(RR,list) or K_<>T then amT();return fi;
  iee:=1;t:=`Curve NOT ok for TorT, etc.: `:
  if sT=1 then lprint(`No point of order 2 in E(Q(T)).`);fi;
  if sT<2 then 
    lprint(`Curve is ok for Tor, etc.`);t:=normal(jay);
    if type(t,rational) then 
      Lprint(`N.B. curve is constant with jay = `,t);
    fi;
  else Lprint(cus,` singular`);
  fi;
  iee:=0:NULL;
end:

torT:=proc() local a,b,c,d,dn,e,flag,h,hx,i,id,j,k,m,mn,n,nd,NNT,p,P,q,rr,\
    s,s1,s2,s4,sp2,sp4,se2,se4,st,v,zz;
  global a5,a21,a41,co,C1,C2,CI,DD,iee,MM,NN,NNeven,ouP,PT,qR,QT,RR,
    sT,s1R,T,u,uR,w,x,y,z;
  if not type(RR,list) or K_<>T then amT();return fi;
  if sT=4 then eprint(qtt);return -1 fi;
  q:=0:NNT:=0;a5:=a6;s:=a||(1..5),T;s2:=iee;iee:=0;
  rr:=RR;RR:=[];st:=sT;s1:=s1R;
  for i while q<3 do
    T:=i:a:=a||(1..5);
    if DD<>0 then
      T:='T';ein(a);tor();NNT:=igcd(NN,NNT):q:=q+1:
    fi;
    T:='T';ell(s);
    if NNT=1 or nops(ouP)=NNT-1 then break;fi;
  od;
  NN:=NNT;iee:=s2;RR:=rr;sT:=st;NNeven:=evalb(sT=0);s1R:=s1;
  if sT=1 then
    while modp(NN,2)=0 do NN:=NN/2:od;
  fi;
  if NN>1 then
    eprint(`Upper bound for NN is `,NN);
    s:=factors(DD)[2]:n:=nops(s):x:='x';y:='y';flag:=0;
    a21:=collect(b2/4+3*s1R,T);a41:=collect(b4/2+b2*s1R/2+3*s1R^2,T);
    a:=x^3+a21*x^2+a41*x-y^2;nd:=1:
    for i to n do
      z:=s[i];p[i]:=z[1]:b[i]:=trunc(z[2]/2);c[i]:=0;nd:=nd*(b[i]+1);
    od;
    if sT=0 then
      if a21<>0 then 
        s2:=factors(gcd(a21,DD))[2];sp2:=[seq(op(1,zz),zz=s2)];
      else sp2:=[];
      fi;
      s4:=factors(a41)[2];sp4:=[seq(op(1,zz),zz=s4)];
      for i to n do
        z:=s[i]:
        if member(z[1],sp2,'j') then se2[i]:=s2[j][2];else se2[i]:=0:fi;
        if member(z[1],sp4,'j') then se4[i]:=s4[j][2];else se4[i]:=0:fi;    
      od;
    else
      a:=a+b6/4;x:=0;v:=[solve(a,y)];
      for i in v do
        y:=i;
        if type(y,polynom(rational,T)) then;torU();fi;
      od;
      for i from 2 by 2 to 6 do 
        v:=collect(b||i,T);sp4[i]:=degree(v,T);
        if v=0 then sp4[i-1]:=0;else sp4[i-1]:=1;fi;
      od;
    fi;
    C1:='C1';y:=C1;
    for id while y<>NULL and nops(ouP)<NN-1 do 
      hx:=1;fprint(`looking at Nagell-Lutz divisor #`,id,` out of `,nd);
      if sT=1 then
        s2:=1;co:=table();x:=co[0];sp2:=0;CI:={C1,co[0]};
        while 3*sp2<=s2 do
          sp2:=sp2+1:x:=x+(co[sp2])*T^sp2;CI:=CI union {co[sp2]};
          s2:=max(sp4[2]+2*sp2*sp4[1],sp4[4]+sp2*sp4[3],sp4[6],2*degree(y,T));
        od;
      else
        for i to n while hx>0 do 
          d[i]:=[];dn[i]:=1;
          for j from 0 to 2*c[i] do
            v:=2*j:mn:=1;
            if a21<>0 then
              k:=j+se2[i]:
              if k<v then v:=k:
              elif k=v then mn:=2;
              fi;
            fi;
            if se4[i]<v then v:=se4[i]:mn:=1;
            elif se4[i]=v then mn:=mn+1;
            fi;
            if (mn=1 and j+v=2*c[i]) or (mn>1 and j+v<=2*c[i]) then 
              d[i]:=[op(d[i]),j]:
            fi;
          od;
          hx:=nops(d[i]);
        od;
        if hx>0 then 
          C2:='C2';h:='h';x:=C2*product(p[h]^d[h][1],h=1..n);CI:={C1,C2};
        fi;
      fi;
      if hx>0 then
        while x<>NULL and nops(ouP)<NN-1 do
          C1:='C1';
          s:=[solve({coeffs(collect(expand(eval(a)),T),T)},CI)]:
          for z in s do
            z:=z minus {0=0};
            if has(z,C2=C2) then flag:=1:next;fi;
            if not type(z,set(name=rational)) then next;fi;
            assign(z);
            if C1<>0 then torU();fi;
            C1:='C1';C2:='C2';
          od;
          if sT=0 then
            C2:='C2';
            for i to n do
              if dn[i]=nops(d[i]) then
                if i=n then x:=NULL;break;
                else x:=x/p[i]^(d[i][dn[i]]-d[i][1]):dn[i]:=1:
                fi;
              else break;
              fi;
            od;
            if x<>NULL then 
              x:=x*p[i]^(d[i][dn[i]+1]-d[i][dn[i]]);dn[i]:=dn[i]+1:
            fi;
          else x:=NULL;
          fi;
        od;
      fi;
      C1:='C1';
      for i to n do
        q:=p[i]:
        if c[i]=b[i] then
          if i=n then y:=NULL;break;
          else y:=y/p[i]^c[i]:c[i]:=0:
          fi;
        else break;
        fi;
      od;
      if y<>NULL then y:=y*q;c[i]:=c[i]+1:fi;
    od;
  fi;
  if NN>nops(ouP)+1 and flag=1 then
    NN:=0;
    eprint(`Ran into a problem -- there may be undiscovered torsion points\
 -- sorry.`);
    if nops(ouP)>0 and iee=1 then 
      Lprint(`Torsion points found: O,`,PP);
    fi;
    if nops(RR)>0 and iee=1 then
      Lprint(`Point(s) of infinite order noticed: `,RR);
    fi;
    return 
  fi;
  uR:={op(ouP)};rr:=[op({op(RR)} minus uR)];RR:=[];
  if nops(rr)>0 and iee=1 then 
    lprint(`We must process the following point(s):`);
    print(rr);
  fi;
  for z in rr do
    if lin(op(RR),z)=0 then uRT(z);
    else RR:=[op(RR),z];uRT(z);
    fi;
  od;
  NN_pair();nowRR(rr);qR:=0;print_PP();NN;    
end: 

uRT:=proc() local i,s,t,ur,z;global uR;
# internal: adjoin to the set uR of `redundant' points all the points 
# z'=[n]z+t where n=-2..2 and t is a torsion point (including t=O). 
  z:=args;ur:=NULL;
  for i to 2 do
    z:=normal(mult(i,z),expanded):
    if not member(z,uR) then
      for t in [[],op(ouP)] do
        s:=normal(eadd(z,t),expanded):ur:=ur,s,normal(neg(s),expanded);
      od;
    fi;
  od;
  uR:=uR union {ur}:
end: 

seekT:=proc() local c,d,e,hx,i,id,n,nd,pt,s,z;
  global a21,a41,C1,f,g,iee,ps,sB,xx,yy;
  if not type(RR,list) or K_<>T then amT();return fi;
  if sT>0 then 
    fprint(`Sorry, can't do Seek for this curve because:`);
    if sT=1 then
fprint(`  for E/Q(T), Seek is only programmed for E with a point of order 2.`);
    else fprint(`   curve is singular: DD=0.`);
    fi;
    return 
  fi;
  do_tor(1);
  a21:=simplify(collect(b2/4+3*s1R,T));
  a41:=simplify(collect(b4/2+b2*s1R/2+3*s1R^2,T));  
  s:=factors(DD)[2]:n:=nops(s):
fprint(`We search for points with x = x'+s1R where x' is a divisor of DD, and`);
eprint(` DD`=factor(DD),` s1R`=s1R);
  C1:='C1';xx:=C1;hx:=0;c:=table();nd:=1:
  for i to n do d[i]:=0;ps[i]:=s[i][1];nd:=nd*(s[i][2]+1);od;
  for id while hx=0 do
    fprint(`Looking at divisor of DD #`,id,` out of`,nd);
    eprint(` x'`=xx);
    f:=collect(xx^3+a21*xx^2+a41*xx,T);i:='i';
    yy:=convert([c[i]*T^i$i=0..trunc(degree(f,T)/2)],`+`);
    g:=collect(f-yy^2,T):
    for z in [solve({coeffs(g,T)})] do
      assign(z);
      if type(xx,polynom(rational)) and type(yy,polynom(rational)) and\
        yy<>0 then 
        pt:=normal([xx+s1R,yy-a1*xx/2-(a3+a1*s1R)/2],expanded):
        if not member(pt,uR) then fprint(`Found point `,pt);ap1_(pt);fi;
      fi;
      c:=table();C1:='C1';
    od;
    for i to n do
      if d[i]=s[i][2] then 
        if i=n then hx:=1;
        else xx:=normal(xx/ps[i]^d[i]):d[i]:=0;
        fi;
      else d[i]:=d[i]+1;xx:=xx*ps[i];break;
      fi;
    od;
  od;
  sB:=1;eprint(` RR`=RR);NULL;
end:  

torU:=proc() local i,j;global e,ouP,PP,PT,QT,RR;
  PT:=normal([x+s1R,y-a1*x/2-(a3+a1*s1R)/2],expanded):
  if member(PT,ouP) then return fi;
  QT:=PT;e:=[PT];
  for i do
    QT:=normal(eadd(PT,QT),expanded);
    if QT=[] then 
      for j to i do
        if not member(e[j],ouP) then 
          PP:=PP,[op(e[j][1..2]),(i+1)/igcd(i+1,j)];
          ouP:=[op(ouP),e[j]]:
        fi;
      od;
      break;
    elif not type(QT[1],polynom) then 
      if not member(PT,RR) and not member(normal(neg(PT),\
expanded),RR) then        
        RR:=[op(RR),PT];
      fi;
      break;
    else e:=[op(e),QT];
    fi;
  od;
end: