/********************************************************************/
/********************************************************************/
/**                                                                **/
/**                    COURBES ELLIPTIQUES                         **/
/**                                                                **/
/**                    Copyright Babe Cool                         **/
/**                                                                **/
/********************************************************************/
/********************************************************************/
/* $Id: elliptic.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */
#include "genpari.h"

void
checkpt(GEN z)
{
  if (typ(z)!=t_VEC) err(elliper1);
}

long
checkell(GEN e)
{
  long lx=lg(e);
  if (typ(e)!=t_VEC || lx<14) err(elliper1);
  return lx;
}

void
checkbell(GEN e)
{
  if (typ(e)!=t_VEC || lg(e)<20) err(elliper1);
}

void
checksell(GEN e)
{
  if (typ(e)!=t_VEC || lg(e)<6) err(elliper1);
}

static void
checkch(GEN z)
{
  if (typ(z)!=t_VEC || lg(z)!=5) err(elliper1);
}

static void
smallinitell0(GEN x, GEN y)
{
  GEN b2,b4,b6,b8,d,j,a11,a13,a33,a64,b81,b22,c4,c6;
  long i;

  checksell(x); for (i=1; i<=5; i++) y[i]=x[i];

  b2=gadd(a11=gsqr((GEN)y[1]),gmul2n((GEN)y[2],2));
  y[6]=(long)b2;

  b4=gadd(a13=gmul((GEN)y[1],(GEN)y[3]),gmul2n((GEN)y[4],1));
  y[7]=(long)b4;

  b6=gadd(a33=gsqr((GEN)y[3]),a64=gmul2n((GEN)y[5],2));
  y[8]=(long)b6;

  b81=gadd(gadd(gmul(a11,(GEN)y[5]),gmul(a64,(GEN)y[2])),gmul((GEN)y[2],a33));
  b8=gsub(b81,gmul((GEN)y[4],gadd((GEN)y[4],a13)));
  y[9]=(long)b8;

  c4=gadd(b22=gsqr(b2),gmulsg(-24,b4));
  y[10]=(long)c4;

  c6=gadd(gmul(b2,gsub(gmulsg(36,b4),b22)),gmulsg(-216,b6));
  y[11]=(long)c6;

  b81=gadd(gmul(b22,b8),gmulsg(27,gsqr(b6)));
  d=gsub(gmul(b4,gadd(gmulsg(9,gmul(b2,b6)),gmulsg(-8,gsqr(b4)))),b81);
  y[12]=(long)d;

  if (gcmp0(d)) err(talker,"singular curve in ellinit");
  
  j = gdiv(gmul(gsqr(c4),c4),d);
  y[13]=(long)j;
}

GEN
smallinitell(GEN x)
{
  GEN y;
  long av,tetpil;

  av=avma; y=cgetg(14,t_VEC);
  smallinitell0(x,y); tetpil=avma;
  return gerepile(av,tetpil,gcopy(y));
}

GEN
ellinit0(GEN x, long flag,long prec)
{
  switch(flag)
  {
    case 0: return initell(x,prec);
    case 1: return smallinitell(x);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

static GEN
do_padic_agm(GEN *ptx1, GEN p, GEN a1, GEN b1, GEN r1)
{
  GEN p1,a,b,x,bmod1, bmod = modii((GEN)b1[4],p), x1 = *ptx1;

  for(;;)
  {
    a=a1; b=b1; x=x1;
    b1=gsqrt(gmul(a,b),0); bmod1=modii((GEN)b1[4],p);
    if (!gegal(bmod1,bmod)) b1 = gneg(b1);
    a1=gmul2n(gadd(gadd(a,b),gmul2n(b1,1)),-2);
    r1=gsub(a1,b1);
    p1=gsqrt(gdiv(gadd(x,r1),x),0);
    if (! gcmp1(modii((GEN)p1[4],p))) p1 = gneg(p1);
    x1=gmul(x,gsqr(gmul2n(gaddsg(1,p1),-1)));
    if (gcmp0(r1)) break;
  }
  *ptx1 = x1; return ginv(gmul2n(a1,2));
}

GEN
initell(GEN x, long prec)
{
  GEN y,b2,b4,disc,c4,c6,p1,p2,p,u,w,pv;
  GEN aa0,bb0,aa1,bb1,r1,x0,x1,u2,q,e0,e1;
  long ty,i,av,tetpil,e,alpha;

  av=avma; y=cgetg(20,t_VEC);
  smallinitell0(x,y);

  e=BIGINT;
  for (i=1; i<=5; i++)
  {
    q=(GEN)y[i];
    if (typ(q)==t_PADIC)
    {
      e = min(e, signe(q[4])? precp(q)+valp(q): valp(q));
      p = (GEN)q[2];
    }
  }
  if (e<BIGINT)
  {
    q=ggrandocp(p,e);
    for (i=1; i<=5; i++) y[i]=ladd(q,(GEN)x[i]);
  }
  b2 = (GEN) y[6];
  b4 = (GEN) y[7];
  c4 = (GEN) y[10];
  c6 = (GEN) y[11];
  disc = (GEN) y[12];

  ty=typ(disc);
  if (ty != t_PADIC)
  {
    if (prec && is_const_t(ty) && ty!=t_INTMOD)
    {
      GEN pi=mppi(prec), pi2=gmul2n(pi,1), tau, w2;
      long sw;

      p1=cgetg(6,t_POL); p1[1]=evalsigne(1) | evallgef(6);
      p1[2]=y[8];         /* b6 */
      p1[3]=lmul2n(b4,1);
      p1[4]=y[6];         /* b2 */
      p1[5]=lstoi(4);
      p1=roots(p1,prec);
      if (gsigne(disc) < 0) p1[1]=lreal((GEN)p1[1]);
      else
      { /* sort roots, real parts in decreasing order */
        GEN tmp;
        i=1; p1 = greal(p1); tmp = (GEN)p1[1];
        if (gcmp((GEN)p1[2],tmp)>0) { i=2; tmp=(GEN)p1[2]; }
        if (gcmp((GEN)p1[3],tmp)>0) { i=3; tmp=(GEN)p1[3]; }
        p1[i]=p1[1]; p1[1]=(long)tmp;

        if (gcmp((GEN)p1[2],(GEN)p1[3])<0)
          { tmp=(GEN)p1[3]; p1[3]=p1[2]; p1[2]=(long)tmp; }
      }
      y[14]=(long)p1;
      
      e1=(GEN)p1[1];
      w = gsqrt(gmul2n(gadd(b4,gmul(e1,gadd(b2,gmulsg(6,e1)))),1),prec);
      p2=gadd(gmulsg(3,e1), gmul2n(b2,-2));
      if (gsigne(p2)>0) w=gneg(w);
      sw=signe(w);

      aa1=gmul2n(gsub(w,p2),-2);
      bb1=gmul2n(w,-1); r1=gsub(aa1,bb1); x1=gmul2n(r1,-2);
      do
      {
        aa0=aa1; bb0=bb1; x0=x1;
        bb1=gsqrt(gmul(aa0,bb0),prec); setsigne(bb1,sw);
        aa1=gmul2n(gadd(gadd(aa0,bb0),gmul2n(bb1,1)),-2);
        r1=gsub(aa1,bb1);
        x1=gmul(x0,gsqr(gmul2n(gaddsg(1,gsqrt(gdiv(gadd(x0,r1),x0),prec)),-1)));
      }
      while (gexpo(r1) > gexpo(bb1) - bit_accuracy(prec) + 6);
      u2=ginv(gmul2n(aa1,2));

      w = gaddsg(1,ginv(gmul2n(gmul(u2,x1),1)));
      q = gsqrt(gaddgs(gsqr(w),-1),prec);
      if (gsigne(greal(w))>0)
        q = ginv(gadd(w,q));
      else
        q = gsub(w,q);
      if (gexpo(q)>=0) q=ginv(q);
      tau=gmul(gdiv(glog(q,prec),pi2), gneg(gi));

      y[19]=lmul(gmul(gsqr(pi2),gabs(u2,prec)),gimag(tau));
      u=gmul(pi2,gsqrt(gneg(u2),prec)); w2=gmul(tau,u);
      if (sw<0) y[15]=(long)u;
      else
      {
        y[15]=lmul2n(gabs((GEN)w2[1],prec),1);
        q=gexp(gmul(gmul(pi2,gi),gdiv(w2,(GEN)y[15])),prec);
      }
      y[16]=(long)w2;
      p1=gdiv(gsqr(pi),gmulsg(6,(GEN)y[15])); q=gsqrt(q,prec);
      y[17]=lmul(p1,gdiv(thetanullk(q,3,prec),thetanullk(q,1,prec)));
      y[18]=ldiv(gsub(gmul((GEN)y[17],(GEN)y[16]),gmul(gi,pi)),(GEN)y[15]);
    }
    else { y[14]=y[15]=y[16]=y[17]=y[18]=y[19]=zero; }
    tetpil=avma; return gerepile(av,tetpil,gcopy(y));
  }

  if (valp(y[13]) >= 0) /* p | j */
    err(talker,"valuation of j must be negative in p-adic ellinit");

  p=(GEN)disc[2];
  if (cmpis(p,2)) pv=p;
  else
  { 
    pv=stoi(4); err(impl,"initell for 2-adic numbers");
  }
  alpha=valp(c4)>>1;
  setvalp(c4,0); setvalp(c6,0); e1=gdivgs(gdiv(c6,c4),6);
  c4=gdivgs(c4,48); c6=gdivgs(c6,864);
  do
  {
    e0=e1; p2=gsqr(e0);
    e1=gdiv(gadd(gmul2n(gmul(e0,p2),1),c6), gsub(gmulsg(3,p2),c4));
  }
  while (!gegal(e0,e1));

  setvalp(e1,valp(e1)+alpha);
  e1=gsub(e1,gdivgs(b2,12));
  w=gsqrt(gmul2n(gadd(b4,gmul(e1,gadd(b2,gmulsg(6,e1)))),1),0);

  p1=gaddgs(gdiv(gmulsg(3,e0),w),1);
  if (valp(p1)<=0) w=gneg(w);
  y[18]=(long)w;

  aa1=gmul2n(gsub(w,gadd(gmulsg(3,e1),gmul2n(b2,-2))),-2);
  bb1=gmul2n(w,-1); r1=gsub(aa1,bb1); x1=gmul2n(r1,-2);
  u2 = do_padic_agm(&x1,pv,aa1,bb1,r1);

  w=gaddsg(1,ginv(gmul2n(gmul(u2,x1),1)));
  q=ginv(gadd(w,gsqrt(gaddgs(gsqr(w),-1),0)));
  if (valp(q)<0) q=ginv(q);

  y[15]=(long)u2;
  y[16] = (kronecker((GEN)u2[4],p) > 0 && (valp(u2)&1) == 0)?
    lsqrt(u2,0): zero;
  y[17]=(long)q; p1=cgetg(2,t_VEC);
  y[14]=(long)p1; p1[1]=(long)e1; y[19]=zero;
  tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

static GEN
ellpol_eval(GEN e, GEN r)
{
  GEN p1;
  p1 = gadd((GEN)e[2],r);
  p1 = gadd((GEN)e[4], gmul(r,p1));
  p1 = gadd((GEN)e[5], gmul(r,p1));
  return p1;
}

GEN
coordch(GEN e, GEN ch)
{
  GEN y,p1,p2,v,v2,v3,v4,v6,r,s,t,u;
  long av,tetpil,i,lx = checkell(e);

  checkch(ch);
  u=(GEN)ch[1]; r=(GEN)ch[2]; s=(GEN)ch[3]; t=(GEN)ch[4];
  av=avma; y=cgetg(lx,t_VEC);
  v=ginv(u); v2=gsqr(v); v3=gmul(v,v2);v4=gsqr(v2); v6=gsqr(v3);
  y[1] = lmul(v,gadd((GEN)e[1],gmul2n(s,1)));
  y[2] = lmul(v2,gsub(gadd((GEN)e[2],gmulsg(3,r)),gmul(s,gadd((GEN)e[1],s))));
  p1 = gadd(gadd(gmul(r,(GEN)e[1]),gmul2n(t,1)),(GEN)e[3]);
  y[3] = lmul(v3,p1);
  p1 = gsub((GEN)e[4],gadd(gmul(t,(GEN)e[1]),gmul(s,p1)));
  y[4] = lmul(v4,gadd(p1,gmul(r,gadd(gmul2n((GEN)e[2],1),gmulsg(3,r)))));
  p1 = ellpol_eval(e,r);
  p2 = gmul(t,gadd(gadd(gmul(r,(GEN)e[1]),t),(GEN)e[3]));
  y[5] = lmul(v6,gsub(p1,p2));
  y[6] = lmul(v2,gadd((GEN)e[6],gmulsg(12,r)));
  y[7] = lmul(v4,gadd((GEN)e[7],gmul(r,gadd((GEN)e[6],gmulsg(6,r)))));
  y[8] = lmul(v6,gadd((GEN)e[8],gmul(r,gadd(gmul2n((GEN)e[7],1),gmul(r,gadd((GEN)e[6],gmul2n(r,2)))))));
  p1 = gadd(gmulsg(3,(GEN)e[7]),gmul(r,gadd((GEN)e[6],gmulsg(3,r))));
  y[9] = lmul(gsqr(v4),gadd((GEN)e[9],gmul(r,gadd(gmulsg(3,(GEN)e[8]),gmul(r,p1)))));
  y[10] = lmul(v4,(GEN)e[10]); 
  y[11] = lmul(v6,(GEN)e[11]);
  y[12] = lmul(gsqr(v6),(GEN)e[12]);
  y[13] = e[13];
  if (lx>14)
  {
    p1=(GEN)e[14];
    if (gcmp0(p1))
    {
      y[14] = y[15] = y[16] = y[17] = y[18] = y[19] = zero;
    }
    else
    {
      if (typ(e[1])==t_PADIC)
      {
        p2=cgetg(2,t_VEC); p2[1]=lmul(v2,gsub((GEN)p1[1],r));
        y[14]=(long)p2;
        y[15]=lmul(gsqr(u),(GEN)e[15]);
        y[16]=lmul(u,(GEN)e[16]);
       /* A MODIFIER : comment changent q et w ??? */
        y[17]=e[17];
        y[18]=e[18];
        y[19]=zero;
      }
      else
      {
        p2=cgetg(4,t_COL);
        for (i=1; i<=3; i++) p2[i]=lmul(v2,gsub((GEN)p1[i],r));
        y[14]=(long)p2;
        y[15]=lmul(u,(GEN)e[15]);
        y[16]=lmul(u,(GEN)e[16]);
        y[17]=ldiv((GEN)e[17],u);
        y[18]=ldiv((GEN)e[18],u);
        y[19]=lmul(gsqr(u),(GEN)e[19]);
      }
    }
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

static GEN
pointch0(GEN x, GEN v2, GEN v3, GEN mor, GEN s, GEN t)
{
  GEN p1,z;

  if (lg(x) < 3) return x; 

  z = cgetg(3,t_VEC); p1=gadd((GEN)x[1],mor);
  z[1] = lmul(v2,p1);
  z[2] = lmul(v3,gsub((GEN)x[2],gadd(gmul(s,p1),t)));
  return z;
}

GEN
pointch(GEN x, GEN ch)
{
  GEN y,v,v2,v3,mor,r,s,t,u;
  long av,tetpil,tx,lx=lg(x),i;

  checkpt(x); checkch(ch);
  if (lx < 2) return gcopy(x);
  av=avma; u=(GEN)ch[1]; r=(GEN)ch[2]; s=(GEN)ch[3]; t=(GEN)ch[4];
  tx=typ(x[1]); v=ginv(u); v2=gsqr(v); v3=gmul(v,v2); mor=gneg(r);
  if (is_matvec_t(tx))
  {
    y=cgetg(lx,tx);
    for (i=1; i<lx; i++)
      y[i]=(long) pointch0((GEN)x[i],v2,v3,mor,s,t);
  }
  else
    y = pointch0(x,v2,v3,mor,s,t);
  tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

static long
ellexpo(GEN e)
{
  long i,k2, k = -gexpo((GEN)e[1]);
  for (i=2; i<6; i++)
  {
    k2 = gexpo((GEN)e[i]);
    if (k<k2) k = k2;
  }
  return k;
}

int
oncurve(GEN e, GEN z)
{
  GEN p1,p2,x,y;
  long av=avma,p,q;

  checksell(e); checkpt(z); if (lg(z)<3) return 1; /* oo */
  x=(GEN)z[1]; y=(GEN)z[2];
  p1 = gmul(y,gadd(y,gadd((GEN)e[3],gmul((GEN)e[1],x))));
  p2 = ellpol_eval(e,x); x = gsub(p1,p2);
  if (gcmp0(x)) { avma=av; return 1; }
  p = precision(p1);
  q = precision(p2); if (p < q) q = p;
  if (!q) { avma=av; return 0; } /* one of p1, p2 is exact */
  /* the constant 0.93 is arbitrary */
  q = (gexpo(x)-ellexpo(e) < - bit_accuracy(q) * 0.93); 
  avma = av; return q;
}

GEN
addell(GEN e, GEN z1, GEN z2)
{
  GEN p1,p2,x,y,x1,x2,y1,y2;
  long av=avma,tetpil;

  checksell(e); checkpt(z1); checkpt(z2);
  if (lg(z1)<3) return gcopy(z2);
  if (lg(z2)<3) return gcopy(z1);

  x1=(GEN)z1[1]; y1=(GEN)z1[2];
  x2=(GEN)z2[1]; y2=(GEN)z2[2];
  if (x1 == x2 || gegal(x1,x2)) /* implies y1 = y2 or -y2 */
  {
    if (y1 != y2)
    {
      long equal;
      if (precision(y1) || precision(y2))
        equal = (gexpo(gadd(y1,y2)) >= gexpo(y1));
      else
        equal = gegal(y1,y2);
      if (!equal)
      { 
        y=cgetg(2,t_VEC); y[1]=zero; return y; 
      }
    }
    p2=gadd((GEN)e[3],gadd(gmul((GEN)e[1],x1),gmul2n(y1,1)));
    if (gcmp0(p2)) { avma=av; y=cgetg(2,t_VEC); y[1]=zero; return y; }
    p1=gadd(gsub((GEN)e[4],gmul((GEN)e[1],y1)),
            gmul(x1,gadd(gmul2n((GEN)e[2],1),gmulsg(3,x1))));
  }
  else { p1=gsub(y2,y1); p2=gsub(x2,x1); }
  p1=gdiv(p1,p2);
  x=gsub(gmul(p1,gadd(p1,(GEN)e[1])),gadd(gadd(x1,x2),(GEN)e[2]));
  y=gneg(gadd(gadd(gadd((GEN)e[3],y1),gmul(x,(GEN)e[1])),gmul(p1,gsub(x,x1))));
  tetpil=avma; p1=cgetg(3,t_VEC); p1[1]=lcopy(x); p1[2]=lcopy(y);
  return gerepile(av,tetpil,p1);
}

static GEN
invell(GEN e, GEN z)
{
  GEN p1;
  
  if (lg(z)<3) return z;
  p1=cgetg(3,t_VEC); p1[1]=z[1];
  p1[2]=lneg(gadd(gadd((GEN)z[2],(GEN)e[3]),gmul((GEN)e[1],(GEN)z[1])));
  return p1;
}

GEN
subell(GEN e, GEN z1, GEN z2)
{
  long av=avma,tetpil;

  checksell(e); checkpt(z2);

  z2=invell(e,z2); tetpil=avma;
  return gerepile(av,tetpil,addell(e,z1,z2));
}

static GEN
quad_sol(long av, GEN d, GEN b, GEN sqrtd)
{
  GEN y, p1 = gsub(sqrtd,b);
  long tetpil = avma;

  if (! signe(d))
  {
    y=cgetg(2,t_VEC);
    y[1]=lmul2n(p1,-1); 
  }
  else
  { 
    y=cgetg(3,t_VEC);
    y[1]=lmul2n(p1,-1); 
    y[2]=lsub((GEN)y[1],sqrtd);
  }
  return gerepile(av,tetpil,y);
}

static GEN
cgetimod(GEN x, GEN y)
{
  GEN p1 = cgetg(3,t_INTMOD);
  p1[1]=(long)x; p1[2]=(long)y; return p1;
}

GEN
ordell(GEN e, GEN x, long prec)
{
  GEN p1,p2,p3,p4,p5,d,y,pd;
  long av=avma,tetpil,td,i,lx,tx=typ(x);

  checksell(e);
  if (is_matvec_t(tx))
  {
    lx=lg(x); y=cgetg(lx,tx);
    for (i=1; i<lx; i++) y[i]=(long)ordell(e,(GEN)x[i],prec);
    return y;
  }

  p1 = ellpol_eval(e,x);
  p2 = gadd((GEN)e[3],gmul((GEN)e[1],x));
  d = gadd(gsqr(p2),gmul2n(p1,2));
  td=typ(d);
  if (td==t_INT)
  {
    if (!carrecomplet(d,&p3))
      { avma=av; return cgetg(1,t_VEC); }
    return quad_sol(av,d,p2, p3);
  }
  if (is_frac_t(td))
  {
    pd=(GEN)d[2]; d=(GEN)d[1]; 
    if (!carrecomplet(mulii(d,pd),&p3))
      { avma=av; return cgetg(1,t_VEC); }
    return quad_sol(av,d,p2, gdiv(p3,pd));
  }

  if (td==t_INTMOD)
  {
    if (! cmpis((GEN)d[1],2)) /* modulo 2 */
    {
      avma=av;
      if (gcmp0(p2))
      {
	y=cgetg(2,t_VEC); p1 = gcmp0(p1)? gzero: gun;
        y[1] = (long) cgetimod(gdeux,p1);
	return y;
      }
      if (gcmp0(p1))
      {
	y=cgetg(3,t_VEC);
        y[1] = (long) cgetimod(gdeux,gzero);
        y[2] = (long) cgetimod(gdeux,gun);
        return y;
      }
      return cgetg(1,t_VEC);
    }
    if (kronecker((GEN)d[2],(GEN)d[1]) == -1)
    { 
      avma=av; y=cgetg(1,t_VEC); return y;
    }
  }

  p3=gsqrt(d,prec); p5=gsub(p3,p2); tetpil=avma; 
  if (gcmp0(d))
  {
    y=cgetg(2,t_VEC);
    y[1]=lmul2n(p5,-1); 
  }
  else 
  {
    if (td==t_REAL || td==t_COMPLEX)
    {
      p1=gneg(p1); p4=gneg(gadd(p3,p2));
      if (gcmp(gnorm(p5),gnorm(p4)) < 0) p5 = p4;
      tetpil=avma;
      y=cgetg(3,t_VEC);
      y[1]=lmul2n(p5,-1); 
      y[2]=ldiv(p1,(GEN)y[1]);
    }
    else
    {
      y=cgetg(3,t_VEC);
      y[1]=lmul2n(p5,-1); 
      y[2]=lsub((GEN)y[1],p3);
    }
  }
  return gerepile(av,tetpil,y);
}

static GEN
CM_powell(GEN e, GEN z, GEN n)
{
  GEN y,p0,p1,q0,q1,p2,q2,z1,z2,pol,grdx,resx,resy;
  long av=avma,tetpil,ln,ep,vn;

  if (lg(z)<3) return gcopy(z);
  pol=(GEN)n[1];
  if (signe(discsr(pol))>=0)
    err(talker,"not a negative quadratic discriminant in CM");
  if (!gcmp1(denom((GEN)n[2])) || !gcmp1(denom((GEN)n[3])))
    err(impl,"powell for nonintegral CM exponent");

  p1=gaddgs(gmul2n(gnorm(n),2),4);
  if (gcmpgs(p1,(((ulong)MAXULONG)>>1)) > 0)
    err(talker,"norm too large in CM");
  ln=itos(p1); vn=(ln-4)>>2; 
  z1 = weipell(e,ln);
  z2 = gsubst(z1,0,gmul(n,polx[0]));
  grdx=gadd((GEN)z[1],gdivgs((GEN)e[6],12));
  p0=gzero; p1=gun; q0=gun; q1=gzero;
  do
  {
    GEN ss=gzero;
    do
    {
      ep=(-valp(z2))>>1; ss=gadd(ss,gmul((GEN)z2[2],gpuigs(polx[0],ep)));
      z2=gsub(z2,gmul((GEN)z2[2],gpuigs(z1,ep)));
    }
    while (valp(z2)<=0);
    p2=gadd(p0,gmul(ss,p1)); p0=p1; p1=p2;
    q2=gadd(q0,gmul(ss,q1)); q0=q1; q1=q2;
    if (!signe(z2)) break;
    z2=ginv(z2);
  }
  while (lgef(p1)-3 < vn);
  if (lgef(p1)-3 > vn || signe(z2))
    err(talker,"not a complex multiplication in powell");
  resx=gdiv(p1,q1); resy=gdiv(deriv(resx,0),n);
  resx=gsub(poleval(resx,grdx), gdivgs((GEN)e[6],12));
  resy=gmul2n(gsub(gmul(gadd(gadd(gmul2n((GEN)z[2],1),gmul((GEN)e[1],(GEN)z[1])),(GEN)e[3]),poleval(resy,grdx)),gadd(gmul((GEN)e[1],resx),(GEN)e[3])),-1);
  tetpil=avma; y=cgetg(3,t_VEC); y[1]=lcopy(resx); y[2]=lcopy(resy);
  return gerepile(av,tetpil,y);
}

GEN
powell(GEN e, GEN z, GEN n)
{
  GEN y;
  long av=avma,i,j,tetpil,s;
  ulong m;

  checksell(e); checkpt(z);
  if (typ(n)==t_QUAD) return CM_powell(e,z,n);
  if (typ(n)!=t_INT)
    err(impl,"powell for nonintegral or non CM exponents");
  if (lg(z)<3) return gcopy(z);
  s=signe(n);
  if (!s) { y=cgetg(2,t_VEC); y[1]=zero; return y; }
  if (s<0) { n=negi(n); z = invell(e,z); }
  if (gcmp1(n)) { tetpil=avma; return gerepile(av,tetpil,gcopy(z)); }

  y=cgetg(2,t_VEC); y[1]=zero;
  for (i=lgefint(n)-1; i>2; i--)
    for (m=n[i],j=0; j<BITS_IN_LONG; j++,m>>=1)
    {
      if (m&1) y=addell(e,y,z);
      z=addell(e,z,z);
    }
  for (m=n[2]; m>1; m>>=1)
  {
    if (m&1) y=addell(e,y,z);
    z=addell(e,z,z);
  }
  tetpil=avma; return gerepile(av,tetpil,addell(e,y,z));
}

GEN
mathell(GEN e, GEN x, long prec)
{
  GEN y,p1,p2, *pdiag;
  long av=avma,tetpil,lx=lg(x),i,j,tx=typ(x);

  if (!is_vec_t(tx)) err(elliper1);
  lx=lg(x); y=cgetg(lx,t_MAT); pdiag=(GEN*) cgeti(lx);
  for (i=1; i<lx; i++)
  { 
    pdiag[i]=ghell(e,(GEN)x[i],prec);
    y[i]=lgetg(lx,t_COL);
  }
  for (i=1; i<lx; i++)
  {
    p1=(GEN)y[i]; p1[i]=lmul2n(pdiag[i],1);
    for (j=i+1; j<lx; j++)
    {
      p2=ghell(e,addell(e,(GEN)x[i],(GEN)x[j]),prec);
      p2=gsub(p2, gadd(pdiag[i],pdiag[j]));
      p1[j]=(long)p2; coeff(y,i,j)=(long)p2;
    }
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

static GEN
bilhells(GEN e, GEN z1, GEN z2, GEN h2, long prec)
{
  long lz1=lg(z1),tx,av=avma,tetpil,i;
  GEN y,p1,p2;

  if (lz1==1) return cgetg(1,typ(z1));

  tx=typ(z1[1]);
  if (!is_matvec_t(tx))
  {
    p1 = ghell(e,addell(e,z1,z2),prec);
    p2 = gadd(ghell(e,z1,prec),h2);
    tetpil=avma; return gerepile(av,tetpil,gsub(p1,p2));
  }
  y=cgetg(lz1,typ(z1));
  for (i=1; i<lz1; i++)
    y[i]=(long)bilhells(e,(GEN)z1[i],z2,h2,prec);
  return y;
}

GEN
bilhell(GEN e, GEN z1, GEN z2, long prec)
{
  GEN p1,h2;
  long av=avma,tetpil,tz1=typ(z1),tz2=typ(z2);

  if (!is_matvec_t(tz1) || !is_matvec_t(tz2)) err(elliper1);
  if (lg(z1)==1) return cgetg(1,tz1);
  if (lg(z2)==1) return cgetg(1,tz2);

  tz1=typ(z1[1]); tz2=typ(z2[1]);
  if (is_matvec_t(tz2))
  {
    if (is_matvec_t(tz1))
      err(talker,"two vector/matrix types in bilhell");
    p1=z1; z1=z2; z2=p1;
  }
  h2=ghell(e,z2,prec); tetpil=avma;
  return gerepile(av,tetpil,bilhells(e,z1,z2,h2,prec));
}

static GEN
get_aa1(GEN e, GEN *ptw, GEN *ptp1, long prec)
{
  GEN r0,p2,w, e1 = gmael(e,14,1), b2 = (GEN)e[6]; 
  long ty = typ(e[12]);

  r0 = gmul2n(b2,-2);
  p2 = gadd(gmulsg(3,e1),r0);
  if (ty == t_PADIC)
    w = (GEN)e[18];
  else
  {
    GEN b4 = (GEN)e[7];
    if (!is_const_t(ty)) err(typeer,"zell");

    w = gsqrt(gmul2n(gadd(b4, gmul(e1,gadd(b2,gmulsg(6,e1)))),1),prec);
    if (gsigne(greal(p2)) > 0) w = gneg(w);
  }
  *ptw = w; r0=gadd(e1,r0); *ptp1 = gmul2n(r0,-1);
  return gmul2n(gsub(w,p2),-2);
}

GEN
zell(GEN e, GEN z, long prec)
{
  long av=avma,ty,sw,fl;
  GEN t,u,w,p1,p2,r1,aa1,bb1,x1,p,u2,xdi;

  checkbell(e);
  if (!oncurve(e,z)) err(heller1);
  ty=typ(e[12]); 
  if (ty==t_INTMOD) err(typeer,"zell");
  if (lg(z)<3) return (ty==t_PADIC)? gun: gzero;

  aa1 = get_aa1(e,&w,&p1,prec);
  bb1 = gmul2n(w,-1); r1 = gsub(aa1,bb1);
  p1 = gadd((GEN)z[1],p1);
  if (!gcmp0(p1))
  {
    GEN delta=gdiv(gmul(aa1,r1),gsqr(p1));
    p1=gmul2n(gmul(p1,gaddsg(1,gsqrt(gsubsg(1,gmul2n(delta,2)),prec))),-1);
  }
  else p1=gsqrt(gneg(gmul(aa1,r1)),prec);
  x1=gmul(p1,gsqr(gmul2n(gaddsg(1,gsqrt(gdiv(gadd(p1,r1),p1),prec)),-1)));

  if (ty==t_PADIC)
  {
    p=gmael(e,12,2);
    u2 = do_padic_agm(&x1,p,aa1,bb1,r1);

    if (!gcmp0((GEN)e[16]))
    {
      t=gsqrt(gaddsg(1,gdiv(x1,aa1)),prec);
      t=gdiv(gaddsg(-1,t),gaddsg(1,t));
    }
    else t=gaddsg(2,ginv(gmul(u2,x1)));
    return gerepileupto(av,t);
  }

  sw=gsigne(greal(w)); fl=0;
  for(;;) /* agm */
  {
    GEN aa0=aa1, bb0=bb1, x0=x1;

    bb1=gsqrt(gmul(aa0,bb0),prec);
    if (gsigne(greal(bb1)) != sw) bb1 = gneg(bb1);
    aa1=gmul2n(gadd(gadd(aa0,bb0),gmul2n(bb1,1)),-2);
    r1=gsub(aa1,bb1);
    p1=gsqrt(gdiv(gadd(x0,r1),x0),prec);
    x1=gmul(x0,gsqr(gmul2n(gaddsg(1,p1),-1)));
    xdi=gsub(x1,x0);
    if (gexpo(xdi) < gexpo(x1) - bit_accuracy(prec) + 5)
    {
      if (fl) break; 
      fl = 1;
    }
    else fl = 0;
  }
  u=gdiv(x1,aa1); t=gaddsg(1,u);
  if (gexpo(t) <  5 - bit_accuracy(prec))
    t = negi(gun);
  else
    t = gdiv(u,gsqr(gaddsg(1,gsqrt(t,prec))));
  u=gsqrt(ginv(gmul2n(aa1,2)),prec);
  t=glog(t,prec); t=gmul(t,u);

  /* which square root? test the reciprocal function (pointell)... */
  if (!gcmp0(t))
  {
    GEN x1;
    long bad;

    u = pointell(e,t,3); /* we don't need much precision */
    /* Either z = u (ok: keep t), or z = invell(e,u) (bad: t <-- -t) */
    x1 = gsub(z,u); bad = (gexpo(x1) >= gexpo(u));
    if (bad) t = gneg(t);
    if (DEBUGLEVEL)
    {
      char *s = bad? "bad": "good";
      if (DEBUGLEVEL>4)
      {
        fprintferr("  z  = ");outerr(z);
        fprintferr("  u  = ");outerr(u);
        fprintferr("  x1 = ");outerr(x1);
        fprintferr("  bad= %ld\n",bad);
      }
      fprintferr("ellpointtoz: `sqrt' gave the %s square root\n",s);
      flusherr();
    }
  }
  /* send t to the fundamental domain if necessary */
  p2 = gdiv(gimag(t),gmael(e,16,2));
  p1 = gsub(p2, gmul2n(gun,-2));
  if (gcmp(gabs(p1,prec),ghalf) >= 0)
    t = gsub(t, gmul((GEN)e[16],gfloor(gadd(p2,dbltor(0.1)))));
  if (gsigne(greal(t)) < 0) t = gadd(t,(GEN)e[15]);
  return gerepileupto(av,t);
}

GEN
pointell(GEN e, GEN z, long prec)
{
  long av=avma,tetpil,lim,av1;
  GEN p1,pii2,pii4,pii6,a,tau,q,u,y,yp,u1,u2,qn,v;

  checkbell(e); p1=mppi(prec); setexpo(p1,2);
  pii2=cgetg(3,t_COMPLEX); pii2[1]=zero; pii2[2]=(long)p1;
  z=gdiv(z,(GEN)e[15]); tau=gdiv((GEN)e[16],(GEN)e[15]);
  a=ground(gdiv(gimag(z),gimag(tau))); z=gsub(z,gmul(a,tau));
  a=ground(greal(z)); z=gsub(z,a);
  if (gexpo(z) < 5 - bit_accuracy(prec))
  { 
    avma=av; v=cgetg(2,t_VEC); v[1]=zero; return v;
  }

  q=gexp(gmul(pii2,tau),prec);
  u=gexp(gmul(pii2,z),prec);
  u1=gsub(gun,u); u2=gsqr(u1);
  y=gadd(gdivgs(gun,12),gdiv(u,u2));
  yp=gdiv(gadd(gun,u),gmul(u1,u2));

  av1=avma; lim=(av1+bot)>>1; qn=q;
  do
  {
    GEN p2,qnu,qnu1,qnu2,qnu3,qnu4;

    qnu=gmul(qn,u); qnu1=gsub(gun,qnu); qnu2=gsqr(qnu1);
    qnu3=gsub(qn,u); qnu4=gsqr(qnu3);
    p1=gsub(gmul(u,gadd(ginv(qnu2),ginv(qnu4))),
	    gmul2n(ginv(gsqr(gsub(gun,qn))),1));
    p1=gmul(qn,p1);
    p2=gadd(gdiv(gadd(gun,qnu),gmul(qnu1,qnu2)),
	    gdiv(gadd(qn,u),gmul(qnu3,qnu4)));
    p2=gmul(qn,p2);
    y=gadd(y,p1); yp=gadd(yp,p2); qn=gmul(q,qn);
    if (low_stack(lim, (av1+bot)>>1))
    {
      GEN *gptr[3];
      if(DEBUGMEM>1) err(warnmem,"pointell");
      gptr[0]=&y; gptr[1]=&yp; gptr[2]=&qn;
      gerepilemany(av1,gptr,3);
    }
  }
  while (gexpo(qn) > - bit_accuracy(prec) - 5);

  pii2=gdiv(pii2,(GEN)e[15]);
  pii4=gsqr(pii2);
  pii6=gmul(pii4,pii2);
  yp= gmul(u,gmul(pii6,yp));
  y = gsub(gmul(pii4,y),gdivgs((GEN)e[6],12));
  yp = gsub(yp,gadd((GEN)e[3],gmul((GEN)e[1],y)));
  tetpil=avma; v=cgetg(3,t_VEC); v[1]=lcopy(y); v[2]=lmul2n(yp,-1);
  return gerepile(av,tetpil,v);
}

GEN
weipell(GEN e, long prec)
{
  long av1,tetpil,precresult,i,k,l;
  GEN result,p1,s,t;

  checkell(e); precresult = 2*prec+2;
  result=cgetg(precresult,t_SER);
  result[1]=evalsigne(1)+evalvarn(0)+HIGHVALPBIT-2;
  for (i=3; i<precresult; i+=2) result[i]=zero;
  result[2]=un;
  result[4]=zero;
  result[6]=ldivgs((GEN)e[10],240);
  result[8]=ldivgs((GEN)e[11],6048);
  for (k=4; k<prec; k++)
  {
    av1 = avma;
    s = k&1? gzero: gsqr((GEN)result[k+2]);
    t = gzero;
    for (l=2; l+l<k; l++)
      t = gadd(t, gmul((GEN)result[(l+1)<<1],(GEN)result[(k-l+1)<<1]));
    p1=gmulsg(3,gadd(s,gmul2n(t,1)));
    tetpil=avma;
    p1=gdivgs(p1,(k-3)*(2*k+1));
    result[(k+1)<<1] = lpile(av1,tetpil,p1);
  }
  return result;
}

/* Calcul de a_p par les sommes de Jacobi */
static GEN
apell2_intern(GEN e, long p)
{
  long av=avma,i,s,e72,e6,e8;

  s=0;
  if (p<757 && p>2)
  {
    GEN unmodp = gmodulss(1,p);
    e6 = itos((GEN)gmul(unmodp,(GEN)e[6])[2]);
    e8 = itos((GEN)gmul(unmodp,(GEN)e[8])[2]);
    e72 = itos((GEN)gmul(unmodp,(GEN)e[7])[2]) << 1;
    for (i=0; i<p; i++)
      s += kross(e8 + i*(e72 + i*(e6 + (i<<2))), p);
  }
  else
  { 
    GEN y, e71 = gmul2n((GEN)e[7],1);
    long av2 = avma;

    for (i=0; i<p; i++)
    {
      y=gadd((GEN)e[8],gmulsg(i,gadd(e71,gmulsg(i,gaddsg(i<<2,(GEN)e[6])))));
      s += krogs(y,p); avma=av2;
    }
  }
  avma=av; return stoi(-s);
}

GEN
apell2(GEN e, GEN pp)
{
  checkell(e); if (typ(pp)!=t_INT) err(elliper1);
  if (cmpsi((ulong)HIGHBIT>>1, pp) <= 0)
    err(talker,"prime too large in jacobi apell2, use apell instead");

  return apell2_intern(e,pp[2]);
}

GEN ellap0(GEN e, GEN p, long flag)
{
  return flag? apell2(e,p): apell(e,p);
}

static GEN
addsell(GEN e, GEN z1, GEN z2)
{
  GEN y,p1,p2,x1,x2,x3,y1,y2,y3,al;
  long av=avma,tetpil;

  if (lg(z1)<3) return gcopy(z2);
  if (lg(z2)<3) return gcopy(z1);

  x1=(GEN)z1[1]; y1=(GEN)z1[2];
  x2=(GEN)z2[1]; y2=(GEN)z2[2];
  if (gegal(x1,x2))
  {
    if (!gegal(y1,y2)) { y=cgetg(2,t_VEC); y[1]=zero; return y; }
    else
    {
      p2=gmul2n(y1,1);
      if (gcmp0(p2)) { avma=av; y=cgetg(2,t_VEC); y[1]=zero; return y; }
      p1=gadd(e,gmul(x1,gmulsg(3,x1)));
    }
  }
  else { p1=gsub(y2,y1); p2=gsub(x2,x1); }
  al=gdiv(p1,p2);
  x3=gsub(gsqr(al),gadd(x1,x2));
  y3=gneg(gadd(y1,gmul(al,gsub(x3,x1))));
  tetpil=avma; y=cgetg(3,t_VEC); y[1]=lcopy(x3); y[2]=lcopy(y3);
  return gerepile(av,tetpil,y);
}

static GEN
doubsell(GEN e, GEN z1)
{
  GEN x1,x3,y3,y,y1,p1,p2,al;
  long av=avma,tetpil;

  if (lg(z1)<3) return gcopy(z1);
  x1=(GEN)z1[1]; y1=(GEN)z1[2];
  p1=gadd(e,gmul(x1,gmulsg(3,x1))); p2=gmul2n(y1,1);
  if (gcmp0(p2)) { avma=av; y=cgetg(2,t_VEC); y[1]=zero; return y; }
  al=gdiv(p1,p2);
  x3=gsub(gsqr(al),gadd(x1,x1));
  y3=gneg(gadd(y1,gmul(al,gsub(x3,x1))));
  tetpil=avma; y=cgetg(3,t_VEC); y[1]=lcopy(x3); y[2]=lcopy(y3);
  return gerepile(av,tetpil,y);
}

#if 0
static GEN
subsell(GEN e, GEN z1, GEN z2)
{
  GEN zp;
  long av=avma,tetpil;

  if (lg(z2)<3) return gcopy(z1);
  zp=cgetg(3,t_VEC); zp[1]=z2[1];
  zp[2]=lneg((GEN)z2[2]);
  tetpil=avma; return gerepile(av,tetpil,addsell(e,z1,zp));
}
#endif

static GEN
powsell(GEN e, GEN z, GEN n)
{
  GEN y,zp;
  long s=signe(n),av=avma,i,j,tetpil;
  ulong m;

  if (!s) { y=cgetg(2,t_VEC); y[1]=zero; return y; }
  if (lg(z)<3) return gcopy(z);
  if (s<0)
  {
    n=gneg(n); zp=cgetg(3,t_VEC); zp[1]=z[1];
    zp[2]=lneg((GEN)z[2]);
  }
  else zp=z;
  if (gcmp1(n)) { tetpil=avma; return gerepile(av,tetpil,gcopy(zp)); }
  y=cgetg(2,t_VEC); y[1]=zero;
  for (i=lgefint(n)-1; i>2; i--)
  {
    for (m=n[i],j=0; j<BITS_IN_LONG; j++,m>>=1)
    {
      if (m&1) y=addsell(e,y,zp);
      zp=doubsell(e,zp);
    }
  }
  for (m=n[2]; m>1; m>>=1)
  {
    if (m&1) y=addsell(e,y,zp);
    zp=doubsell(e,zp);
  }
  tetpil=avma; y=addsell(e,y,zp);
  return gerepile(av,tetpil,y);
}

static GEN
powssell(GEN e, GEN z, long n)
{
  GEN y,zp;
  long av=avma,tetpil;
  ulong m;

  if (!n) { y=cgetg(2,t_VEC); y[1]=zero; return y; }
  if (lg(z)<3) return gcopy(z);
  if (n<0)
  {
    n= -n; zp=cgetg(3,t_VEC); zp[1]=z[1];
    zp[2]=lneg((GEN)z[2]);
  }
  else zp=z;
  if (n==1) { tetpil=avma; return gerepile(av,tetpil,gcopy(zp)); }
  y=cgetg(2,t_VEC); y[1]=zero;
  for (m=n; m>1; m>>=1)
  {
    if (m&1) y=addsell(e,y,zp);
    zp=doubsell(e,zp);
  }
  tetpil=avma; y=addsell(e,y,zp);
  return gerepile(av,tetpil,y);
}

#define HASHSP 255

static GEN
apell1(GEN e, GEN p)
{
  long av,av3,tetpil,k,k2,i,j,j1,lim,limite,com,j2,s, *tabla, *tablb, *hash;
  GEN p1,p2,p3,q,h,hp,f,fh;
  GEN unmodp,pordmin,u,p1p,p2p,acon,bcon,xp,yp,c4,c6,cp4;
  long flc,flcc,x, count[256], index[257];

  checkell(e);
  if (gcmpgs(p,20)<0) return apell2(e,p);
  if (gexpo(p)>85) err(impl,"apell for p>10^25");
  tabla = (long*)gpmalloc(1000000 * sizeof(long));
  tablb = (long*)gpmalloc(1000000 * sizeof(long));
  hash  = (long*)gpmalloc(1000000 * sizeof(long));

  av=avma; limite=(av+bot)>>1; unmodp=gmodulsg(1,p);
  c4 = gdivgs(gmul(unmodp,(GEN)e[10]),-48);
  c6 = gdivgs(gmul(unmodp,(GEN)e[11]),-864);
  pordmin=gceil(gmul2n(gsqrt(p,DEFAULTPREC),2));
  p2p=gmul2n(p1p=gaddsg(1,p),1);
  x=0; flcc=0; flc=kronecker((GEN)c6[2],p);
  u=c6; acon=gzero; bcon=gun; h=p1p;
  for(;;)
  {
    while (flc==flcc || !flc)
    {
      x++; u=gadd(c6,gmulsg(x,gaddgs(c4,x*x)));
      flc=kronecker((GEN)u[2],p);
    }
    flcc=flc;
    s=itos(gceil(gsqrt(gdiv(pordmin,bcon),DEFAULTPREC)))>>1;
    cp4=gmul(c4,yp=gsqr(u));
    xp=gmulsg(x,u); f=cgetg(3,t_VEC); f[1]=(long)xp; f[2]=(long)yp;
    fh=powsell(cp4,f,h);
    if (bcon != gun) f=powsell(cp4,f,bcon); /* sic */
    p1=fh;
    for (i=0; i<=HASHSP; i++) count[i]=0;
    for (i=0; i<=s-1; i++)
    {
      if (lg(p1)!=3) break;

      p2=gmael(p1,1,2); tabla[i]=p2[lgefint(p2)-1];
      j=tabla[i]&HASHSP; count[j]++;
      p2=gmael(p1,2,2); tablb[i]=p2[lgefint(p2)-1];
      p1=addsell(cp4,p1,f);
    }
    if (i == s)
    {
      long pfinal=p[lgefint(p)-1];
      GEN fg=powssell(cp4,f,s), ftest=fg;

      index[0]=0; for (i=0; i<=HASHSP-1; i++) index[i+1]=index[i]+count[i];
      for (i=0; i<=s-1; i++) hash[index[tabla[i]&HASHSP]++]=i;
      index[0]=0; for (i=0; i<=HASHSP; i++) index[i+1]=index[i]+count[i];
      com=1; av3=avma;
      for(;;)
      {
	p1=gmael(ftest,1,2); k=p1[lgefint(p1)-1]; j=k&HASHSP;
	if (lg(ftest) != 3) { j1=index[j+1]; j2=hash[j1-1]; }
	else
	  for (j1=index[j]; j1<index[j+1]; j1++)
	  {
	    j2=hash[j1];
	    if (tabla[j2]==k)
	    {
	      p2=gmael(ftest,2,2); k2=p2[lgefint(p2)-1];
	      if (tablb[j2]==k2 || tablb[j2]==pfinal-k2)
	      {
		p1=addsell(cp4,powssell(cp4,f,j2),fh);
		if (gegal((GEN)p1[1],(GEN)ftest[1])) break; /* success */
	      }
	    }
	  }
	if (j1 != index[j+1]) break; /* success */

	com++; tetpil=avma; ftest=addsell(cp4,ftest,fg);
	if (lg(ftest)<3) err(bugparier,"apell");
        if (low_stack(limite, (av+bot)>>1))
	  ftest=gerepile(av3,tetpil,ftest);
      }
      h=addii(h,mulsi(j2,bcon)); p2=mulsi(s,mulsi(com,bcon));
      h=(!cmpii(gmael(p1,2,2),gmael(ftest,2,2))) ? subii(h,p2) : addii(h,p2);
    }
    else h=addii(h,mulsi(i-1,bcon));
    p2=factor(h);
    p1=(GEN)p2[1]; p2=(GEN)p2[2];
    for (i=1; i<lg(p1); i++)
    {
      p3=divii(h,(GEN)p1[i]); fh=powsell(cp4,f,p3); lim=itos((GEN)p2[i]);
      for (j=1; j<=lim && lg(fh)<3; j++)
      {
	h=p3; if (j<lim) { p3=divii(h,(GEN)p1[i]); fh=powsell(cp4,f,p3); }
      }
    }
    p1=gmodulcp(acon,bcon); p2=gmodulsg(0,h);
    p1=chinois(p1,p2); acon=(GEN)p1[2]; bcon=(GEN)p1[1];

    if (gcmp(bcon,pordmin)>=0)
    {
      q=ground(gdiv(gsub(p1p,acon),bcon));
      hp=addii(mulii(q,bcon),acon); tetpil=avma;
      break;
    }

    acon=modii(subii(p2p,acon),bcon);
    p1=subii(acon,bcon); if (signe(addii(acon,p1))>0) acon=p1;
    q=ground(gdiv(gsub(p1p,acon),bcon));
    h=addii(mulii(q,bcon),acon);
  }
  free(tabla); free(tablb); free(hash);
  p1 = (flc==1) ? gsub(p1p,hp) : gsub(hp,p1p);
  return gerepile(av,tetpil,p1);
}

typedef struct
{ 
  int isnull;
  long x,y;
} sellpt;

static void
addsell1(long e, long p, sellpt *p1, sellpt *p2, sellpt *p3)
{
  long num, den, lambda;

  if (p1->isnull) { *p3 = *p2; return; }
  if (p2->isnull) { *p3 = *p1; return; }
  if (p1->x == p2->x)
    if (p1->y && p1->y == p2->y)
    {
      num = addssmod(e, mulssmod(3, mulssmod(p1->x, p1->x, p), p), p);
      den = addssmod(p1->y, p1->y, p);
    }
    else
    {
      p3->isnull = 1; return;
    }
  else
  {
    num = subssmod(p1->y, p2->y, p);
    den = subssmod(p1->x, p2->x, p);
  }
  lambda = divssmod(num, den, p);
  p3->x = subssmod(mulssmod(lambda, lambda, p), addssmod(p1->x, p2->x, p), p);
  p3->y = subssmod(mulssmod(lambda, subssmod(p2->x, p3->x, p), p), p2->y, p);
  p3->isnull = 0;
}

static void
powssell1(long e, long p, long n, sellpt *p1, sellpt *p2)
{
  sellpt p4, p3;

  p3 = *p1;
  if (n < 0) { n = -n; if (p3.y) p3.y = p - p3.y; }
  p2->isnull = 1;
  for(;;)
  {
    if (n&1) addsell1(e, p, p2, &p3, p2);
    n>>=1; if (!n) return;
    addsell1(e, p, &p3, &p3, &p4);
    p3 = p4;
  }
}

typedef struct
{ 
  long x,y,i;
} multiple;

static int
compare_multiples(multiple *a, multiple *b)
{
  return a->x - b->x;
}

/* assume e has good reduction at p */
static GEN
apell0(GEN e, long p)
{
  GEN p1,p2,unmodp;
  sellpt f,fh,fg,ftest,f2;
  long pordmin,u,p1p,p2p,acon,bcon,xp,yp,c4,c6,cp4;
  long av,i,j,com,s,flb,flc,flcc,x,q,h,p3,l,r,m;
  multiple *table;

  if (p <= 457) return apell2_intern(e,p);

  av = avma; unmodp = gmodulss(1,p);
  c4 = itos((GEN)gdivgs(gmul(unmodp,(GEN)e[10]), -48)[2]);
  c6 = itos((GEN)gdivgs(gmul(unmodp,(GEN)e[11]), -864)[2]);
  pordmin = (long)(1 + 4*sqrt((float)p));
  p1p = p+1; p2p = p1p << 1;
  x=0; flcc=0; flc = kross(c6, p); u=c6; acon=0; bcon=1;
  h=p1p;
  for(;;)
  {
    while (flc==flcc || !flc)
    {
      x++;
      u = addssmod(c6, mulssmod(x, c4+mulssmod(x,x,p), p), p);
      flc = kross(u,p);
    }
    flcc = flc;
    s = (long) (sqrt(((float)pordmin)/bcon) / 2);
    if (!s) s=1;
    if (bcon==1) table = (multiple *) gpmalloc((s+1)*sizeof(multiple));
    yp = mulssmod(u, u, p);
    cp4 = mulssmod(c4, yp, p);
    xp = mulssmod(x, u, p);
    f.isnull = 0; f.x = xp; f.y = yp;
    powssell1(cp4, p, h, &f, &fh);
    if (bcon > 1) powssell1(cp4, p, bcon, &f, &f2); else f2=f;
    for (i=0; i < s; i++)
    {
      if (fh.isnull)
      {
	h += bcon*i;
	goto trouve;
      }
      table[i].x = fh.x; table[i].y = fh.y; table[i].i = i;
      addsell1(cp4, p, &fh, &f2, &fh);
    }
    qsort(table,s,sizeof(multiple),(int (*)(ANYARG))compare_multiples);
    powssell1(cp4, p, s, &f2, &fg); ftest = fg;
    for (com = 1; ; com++)
    {
      if (ftest.isnull) err(bugparier,"apell (f^(com*s) = 1)");
      l=0; r=s;
      while (l<r)
      {
	m = (l+r) >> 1;
	if (table[m].x < ftest.x) l=m+1; else r=m;
      }
      if (r < s && table[r].x == ftest.x) break;
      addsell1(cp4, p, &ftest, &fg, &ftest);
    }
    h += table[r].i * bcon;
    if (table[r].y == ftest.y)
      h -= s*com*bcon;
    else
      h += s*com*bcon;

  trouve:
    p2=factor(stoi(h));
    p1=(GEN)p2[1]; p2=(GEN)p2[2];
    for (i=1; i < lg(p1); i++)
      for (j = mael(p2,i,2); j; j--)
      {
	p3 = h / mael(p1,i,2);
	powssell1(cp4, p, p3, &f, &fh);
	if (!fh.isnull) break;
	h = p3;
      }
    flb=0;
    if (bcon > 1)
    {
      p1 = gmodulss(acon,bcon); p2=gmodulss(0,h);
      p1=chinois(p1,p2); acon=itos((GEN)p1[2]); bcon=mael(p1,1,2);
      if (bcon<0 || lgef(p1[1])>3) flb=1;
    }
    else
      bcon = h;
    if (flb || bcon >= pordmin)
    {
      if (flb) h=acon;
      else
      {
	q = ((ulong)(p2p + bcon - (acon << 1))) / (bcon << 1);
	h = acon + q*bcon;
      }
      break;
    }
    else
    {
      acon = (p2p - acon) % bcon;
      if ((acon << 1) > bcon) acon -= bcon;
      q = ((ulong)(p2p + bcon - (acon << 1))) / (bcon << 1);
      h = acon + q*bcon;
    }
  }
  avma = av; free(table);
  return stoi((flc==1)?  p1p-h: h-p1p);
}

GEN
apell(GEN e, GEN prime)
{
  long p;

  checkell(e);
  if (divise((GEN)e[12],prime))
  {
    p = kronecker((GEN)e[11],prime);
    switch(mod4(prime))
    {
      case 0: case 3:
	return stoi(-p);
      case 1: case 2:
	return stoi(p);
    }
  }
  if (gcmpgs(prime, 0x3fffffff) > 0) return apell1(e, prime);
  p = itos(prime); if (p<=457) return apell2_intern(e,p);
  return apell0(e,p);
}

/* TEMPC is the largest prime whose square is less than HIGHBIT */
#ifndef LONG_IS_64BIT
#  define TEMPC 46337
#  define TEMPMAX 16777215UL
#else
#  define TEMPC 3037000493
#  define TEMPMAX 4294967295UL
#endif

GEN
anell(GEN e, long n)
{
  long tab[4]={0,1,1,-1}; /* p prime; (-1/p) = tab[p&3]. tab[0] is not used */
  long p, pk, i, m, av, tetpil;
  GEN p1,p2,an;

  checkell(e);
  if (n <= 0) return cgetg(1,t_VEC);
  if (n>TEMPMAX) err(impl,"anell for n>=2^24 (or 2^32 for 64 bit machines)");
  an = cgetg(n+1,t_VEC); an[1] = un;
  for (i=2; i <= n; i++) an[i] = 0;
  for (p=2; p<=n; p++)
    if (!an[p])
    {
      if (!smodis((GEN)e[12],p)) /* mauvaise reduction, p | e[12] */
	switch (tab[p&3] * krogs((GEN)e[11],p)) /* renvoie (-c6/p) */
	{
	  case -1:  /* non deployee */
	    for (m=p; m<=n; m+=p)
	      if (an[m/p]) an[m]=lneg((GEN)an[m/p]);
	    continue;
	  case 0:   /* additive */
	    for (m=p; m<=n; m+=p) an[m]=zero;
	    continue;
	  case 1:   /* deployee */
	    for (m=p; m<=n; m+=p)
	      if (an[m/p]) an[m]=lcopy((GEN)an[m/p]);
	}
      else /* bonne reduction */
      {
        GEN ap = apell0(e,p);

	if(p < TEMPC)
	{
	  long oldpk = 1;
	  for (pk=p; pk <= n; oldpk=pk, pk *= p)
	  {
	    if (pk == p) an[pk] = (long) ap;
	    else
	    {
	      av = avma;
	      p1 = mulii(ap, (GEN)an[oldpk]);
	      p2 = mulsi(p, (GEN)an[oldpk/p]);
	      tetpil = avma;
	      an[pk] = lpile(av,tetpil,subii(p1,p2));
	    }
	    for (m = n/pk; m > 1; m--)
	      if (an[m] && m%p) an[m*pk] = lmulii((GEN)an[m], (GEN)an[pk]);
	  }
	}
	else
	{
	  an[p] = (long) ap;
	  for (m = n/p; m > 1; m--)
	    if (an[m] && (m%p)) an[m*p] = lmulii((GEN)an[m], (GEN)an[p]);
	}
      } 
    }
  return an;
}

GEN
akell(GEN e, GEN n)
{
  long i,j,ex,av=avma;
  GEN p1,p2,ap,u,v,w,y,pl;

  checkell(e);
  if (typ(n)!=t_INT) err(talker,"not an integer type in akell");
  if (signe(n)<= 0) return gzero;
  y=gun; if (gcmp1(n)) return y;
  p2=auxdecomp(n,1); p1=(GEN)p2[1]; p2=(GEN)p2[2];
  for (i=1; i<lg(p1); i++)
  {
    pl=(GEN)p1[i];
    if (divise((GEN)e[12], pl)) /* mauvaise reduction */
    {
      j = (((mod4(pl)+1)&2)-1)*kronecker((GEN)e[11],pl);
      if (j<0 && mpodd((GEN)p2[i])) y = negi(y);
      if (!j) { avma=av; return gzero; }
    }
    else /* bonne reduction */
    {
      ap=apell(e,pl); ex=itos((GEN)p2[i]);
      u=ap; v=gun;
      for (j=2; j<=ex; j++)
      {
	w = subii(mulii(ap,u), mulii(pl,v));
	v=u; u=w;
      }
      y = mulii(u,y);
    }
  }
  return gerepileupto(av,y);
}

GEN
hell(GEN e, GEN a, long prec)
{
  long av=avma,tetpil,n;
  GEN p1,p2,y,z,q,psi2,pi2surw,pi2isurw,qn,ps;

  checkbell(e);
  pi2surw=gdiv(gmul2n(mppi(prec),1),(GEN)e[15]);
  pi2isurw=cgetg(3,t_COMPLEX); pi2isurw[1]=zero; pi2isurw[2]=(long)pi2surw;
  z=gmul(greal(zell(e,a,prec)),pi2surw);
  q=greal(gexp(gmul((GEN)e[16],pi2isurw),prec));
  psi2=gadd((GEN)e[3],gadd(gmul((GEN)e[1],(GEN)a[1]),gmul2n((GEN)a[2],1)));
  y=gsin(z,prec); n=0; qn=gun; ps=gneg(q);
  do
  {
    n++; p1=gsin(gmulsg(n+n+1,z),prec); qn=gmul(qn,ps);
    ps=gmul(ps,q); p1=gmul(p1,qn); y=gadd(y,p1);
  }
  while (gexpo(qn) >= - bit_accuracy(prec));
  p1=gmul(gsqr(gdiv(gmul2n(y,1),psi2)),pi2surw);
  p2=gsqr(gsqr(gdiv(p1,gsqr(gsqr(denom((GEN)a[1]))))));
  p1=gdiv(gmul(p2,q),(GEN)e[12]);
  p1=gmul2n(glog(gabs(p1,prec),prec),-5);
  tetpil=avma; return gerepile(av,tetpil,gneg(p1));
}

static GEN
hells(GEN e, GEN x, long prec)
{
  GEN w,z,t,mu,e72,e82,unreel = cgetr(prec);
  long n,lim;

  affsr(1,unreel); t = gdiv(unreel,(GEN)x[1]);
  mu = gmul2n(glog(numer((GEN)x[1]),prec),-1);
  e72 = gmul2n((GEN)e[7],1);
  e82 = gmul2n((GEN)e[8],1);
  lim = 6 + (bit_accuracy(prec) >> 1);
  for (n=0; n<lim; n++)
  {
    w = gmul(t,gaddsg(4,gmul(t,gadd((GEN)e[6],gmul(t,gadd(e72,gmul(t,(GEN)e[8])))))));
    z = gsub(gun,gmul(gsqr(t),gadd((GEN)e[7],gmul(t,gadd(e82,gmul(t,(GEN)e[9]))))));
    mu = gadd(mu,gmul2n(glog(z,prec), -((n<<1)+3)));
    t = gdiv(w,z);
  }
  return mu;
}

GEN
hell2(GEN e, GEN x, long prec)
{
  GEN ep,e3,ro,p1,p2,mu,d,xp;
  long av=avma,tetpil,lx,lc,i,j,tx;

  if (!oncurve(e,x)) err(heller1);
  d=(GEN)e[12]; ro=(GEN)e[14]; e3=(gsigne(d) < 0)?(GEN)ro[1]:(GEN)ro[3];
  p1=cgetg(5,t_VEC); p1[1]=un; p1[2]=laddgs(gfloor(e3),-1);
  p1[3]=p1[4]=zero; ep=coordch(e,p1); xp=pointch(x,p1);
  tx=typ(x[1]); lx=lg(x);
  if (!is_matvec_t(tx))
  {
    if (lx<3) { avma=av; return gzero; }
    tetpil=avma; return gerepile(av,tetpil,hells(ep,xp,prec));
  }
  tx=typ(x);
  tetpil=avma; mu=cgetg(lx,tx);
  if (tx != t_MAT)
    for (i=1; i<lx; i++) mu[i]=(long)hells(ep,(GEN)xp[i],prec);
  else
  {
    lc=lg(x[1]);
    for (i=1; i<lx; i++)
    {
      p1=cgetg(lc,t_COL); mu[i]=(long)p1; p2=(GEN)xp[i];
      for (j=1; j<lc; j++) p1[j]=(long)hells(ep,(GEN)p2[j],prec);
    }
  }
  return gerepile(av,tetpil,mu);
}

GEN
ellheight0(GEN e, GEN a, long flag, long prec)
{
  switch(flag)
  {
    case 0:  return ghell(e,a,prec);
    case 1:  return ghell2(e,a,prec);
    default:  err(flagerr);
  }
  return NULL; /* not reached */
}

/* On suppose que `e' est a coeffs entiers donnee par un modele minimal */
static GEN
ghell0(GEN e, GEN a, long flag, long prec)
{
  long av=avma,lx,i,n,n2,grandn,tx=typ(a);
  GEN p,p1,p2,x,y,z,phi2,psi2,psi3,logdep;

  checkbell(e); if (!is_matvec_t(tx)) err(elliper1);
  lx = lg(a); if (lx==1) return cgetg(1,tx);
  tx=typ(a[1]);
  if (is_matvec_t(tx))
  {
    z=cgetg(lx,tx);
    for (i=1; i<lx; i++) z[i]=(long)ghell0(e,(GEN)a[i],flag,prec);
    return z;
  }
  if (lg(a)<3) return gzero;
  if (!oncurve(e,a)) err(heller1);

  x=(GEN)a[1]; y=(GEN)a[2];
  psi2=numer(gadd((GEN)e[3],gadd(gmul((GEN)e[1],x),gmul2n(y,1))));
  if (!signe(psi2)) { avma=av; return gzero; }

  p2=gadd(gmulsg(3,(GEN)e[7]),gmul(x,gadd((GEN)e[6],gmulsg(3,x))));
  psi3=numer(gadd((GEN)e[9],gmul(x,gadd(gmulsg(3,(GEN)e[8]),gmul(x,p2)))));
  if (!signe(psi3)) { avma=av; return gzero; }

  p1 = gmul(x,gadd(shifti((GEN)e[2],1),gmulsg(3,x)));
  phi2=numer(gsub(gadd((GEN)e[4],p1), gmul((GEN)e[1],y)));
  p1=(GEN)factor(mppgcd(psi2,phi2))[1]; lx=lg(p1);
  if (flag)
    z = hell(e,a,prec); /* Silverman trick */
  else
    z = hell2(e,a,prec); /* Tate 4^n */
  for (i=1; i<lx; i++)
  {
    p=(GEN)p1[i]; 
    if (signe(resii((GEN)e[10],p)))
    {
      grandn=ggval((GEN)e[12],p);
      if (grandn)
      {
        n2=ggval(psi2,p); n=n2<<1;
        logdep=gneg(glog(p,prec));
	if (n>grandn) n=grandn;
	p2=divrs(mulsr(n*(grandn+grandn-n),logdep),grandn<<3);
	z=gadd(z,p2);
      }
    }
    else
    {
      n2=ggval(psi2,p);
      logdep=gneg(glog(p,prec));
      n=ggval(psi3,p);
      if (n>=3*n2) p2=gdivgs(mulsr(n2,logdep),3);
      else p2=gmul2n(mulsr(n,logdep),-3);
      z=gadd(z,p2);
    }
  }
  return gerepileupto(av,z);
}

GEN
ghell2(GEN e, GEN a, long prec)
{
  return ghell0(e,a,0,prec);
}

GEN
ghell(GEN e, GEN a, long prec)
{
  return ghell0(e,a,1,prec);
}

GEN
lseriesell(GEN e, GEN s, GEN N, GEN A, long prec)
{
  long av=avma,av1,tetpil,lim,l,n,eps;
  GEN z,p1,p2,cg,cg1,v,cga,cgb,s2,ns,gs;

  checkell(e); if (typ(N)!=t_INT || !signe(N)) err(elliper1);
  if (gsigne(A)<=0) 
    err(talker,"cut-off point must be positive in lseriesell");
  if (gcmpgs(A,1) < 0) A=ginv(A);
  eps=signe(N); if (eps<0) N=gneg(N);
  cg1=mppi(prec); setexpo(cg1,2); cg=divrr(cg1,gsqrt(N,prec));
  cga=gmul(cg,A); cgb=gdiv(cg,A);
  l=(long)((pariC2*(prec-2) + fabs(gtodouble(s)-1.)*log(rtodbl(cga)))
            / rtodbl(cgb)+1);
  v=anell(e,min(l,TEMPMAX));
  s2=gsubsg(2,s); ns=gpui(cg,gsubgs(gmul2n(s,1),2),prec);
  z=gzero;
  if (typ(s)==t_INT)
  {
    if (signe(s)<=0) { avma=av; return gzero; }
    gs=mpfactr(itos(s)-1,prec);
  }
  else gs=ggamma(s,prec);
  av1=avma; lim=(av1+bot)>>1;
  for (n=1; n<=l; n++)
  {
    p1=gdiv(incgam4(s,gmulsg(n,cga),gs,prec),gpui(stoi(n),s,prec));
    p2=gdiv(gmul(ns,incgam(s2,gmulsg(n,cgb),prec)),gpui(stoi(n),s2,prec));
    if (eps<0) p2=gneg(p2);
    z = gadd(z,gmul(gadd(p1,p2),(n<=TEMPMAX)? (GEN)v[n]: akell(e,stoi(n))));
    if (low_stack(lim, (av1+bot)>>1))
    {
      if(DEBUGMEM>1) err(warnmem,"lseriesell");
      tetpil=avma; z=gerepile(av1,tetpil,gcopy(z));
    }
  }
  tetpil=avma; return gerepile(av,tetpil,gdiv(z,gs));
}

/********************************************************************/
/**                                                                **/
/**                Algorithme de Tate (cf Anvers IV)               **/
/**             Type de Kodaira, modele minimal global             **/
/**                                                                **/
/********************************************************************/

/*
  Etant donnes une courbe elliptique sous forme longue e, dont les coefficients
  sont entiers, et un nombre premier p1, renvoie le type de la fibre en p du
  modele de Neron de la courbe, ainsi que les changements de variables
  necessaires, sous la forme d'un quadruplet [f, kod, v, c].

  L'entier f est l'exposant du conducteur.

  l'entier kod, est le type de kodaira. les types II, III et IV sont codes 2,
  3, et 4 respectivement. Les types II*, III* et IV* donnent -2, -3 et -4. Le
  type I0* donne -1, les types Inu et Inu* donnent 4+nu et -4-nu. Enfin, le
  type I0 donne 1.

  v est un quadruplet [u, r, s, t] qui permet de passer a un modele minimal.
  En general, on ne s'interessera a ce vecteur que si u != 1.

  c est le nombre de Tamagawa.

  L'algorithme est bien sur celui de Tate dans Anvers IV. Compte tenu des
  remarques du bas de la page 46, l'algorithme long n'est utilise que pour
  p=2 ou p=3.

 */

static void cumule(GEN *vtotal, GEN *e, GEN u, GEN r, GEN s, GEN t);
static void cumule1(GEN *vtotal, GEN *e, GEN v2);

static GEN
localreduction_result(long av, long f, long kod, long c, GEN v)
{
  long tetpil = avma;
  GEN result = cgetg(5, t_VEC);
  result[1] = lstoi(f); result[2] = lstoi(kod);
  result[3] = lcopy(v); result[4] = lstoi(c);
  return gerepile(av,tetpil, result);
}

/* ici, p1 != 2 et p1 != 3 */
static GEN
localreduction_carac_not23(GEN e, GEN p1)
{
  long av = avma, k, f, kod, c, nuj, nudelta;
  GEN pk, p2k, a2prime, a3prime;
  GEN p2, r = gzero, s = gzero, t = gzero, v;
  GEN c4, c6, delta, unmodp, xun, tri, var, p4k, p6k;

  nudelta = ggval((GEN)e[12], p1);
  v = cgetg(5,t_VEC); v[1] = un; v[2] = v[3] = v[4] = zero;
  nuj = gcmp0((GEN)e[13]) ? 0 : - ggval((GEN)e[13], p1);
  k = (nuj > 0 ? nudelta - nuj : nudelta) / 12;
  c4 = (GEN)e[10]; c6 = (GEN)e[11]; delta = (GEN)e[12];
  if (k > 0) /* modele non minimal */
  {
    pk = gpuigs(p1, k);
    if (mpodd((GEN)e[1]))
      s = shifti(subii(pk, (GEN)e[1]), -1);
    else
      s = negi(shifti((GEN)e[1], -1));
    p2k = sqri(pk);
    p4k = sqri(p2k);
    p6k = mulii(p4k, p2k);

    a2prime = subii((GEN)e[2], mulii(s, addii((GEN)e[1], s)));
    switch(smodis(a2prime, 3))
    {
      case 0: r = negi(divis(a2prime, 3)); break;
      case 1: r = divis(subii(p2k, a2prime), 3); break;
      case 2: r = negi(divis(addii(a2prime, p2k), 3)); break;
    }
    a3prime = addii((GEN)e[3], mulii(r, (GEN)e[1]));
    if (mpodd(a3prime))
      t = shifti(subii(mulii(pk, p2k), a3prime), -1);
    else
      t = negi(shifti(a3prime, -1));
    v[1] = (long)pk; v[2] = (long)r; v[3] = (long)s; v[4] = (long)t;
    nudelta -= 12 * k;
    c4 = divii(c4, p4k); c6 = divii(c6, p6k);
    delta = divii(delta, sqri(p6k));
  }
  if (nuj > 0) switch(nudelta - nuj)
  {
    case 0: f = 1; kod = 4+nuj; /* Inu */
      switch(kronecker(gneg(c6),p1))
      {
	case  1: c = nudelta; break;
	case -1: c = 2 - (nudelta % 2); break;
	default: err(tater1);
      }
      break;
    case 6: f = 2; kod = -4-nuj; /* Inu* */
      if (nuj & 1)
	c = 3 + kronecker(divii(mulii(c6, delta),gpuigs(p1, 9+nuj)), p1);
      else
	c = 3 + kronecker(divii(delta, gpuigs(p1, 6+nuj)), p1);
      break;
    default: err(tater1);
  }
  else switch(nudelta)
  {
    case  0: f = 0; kod = 1; c = 1; break; /* I0, regulier */
    case  2: f = 2; kod = 2; c = 1; break; /* II   */
    case  3: f = 2; kod = 3; c = 2; break; /* III  */
    case  4: f = 2; kod = 4; /* IV   */
      c = 2 + kronecker(gdiv(mulis(c6, -6), sqri(p1)), p1);
      break;
    case  6: f = 2; kod = -1; /* I0*  */
      p2 = sqri(p1);
      unmodp = gmodulsg(1,p1);
      var = gmul(unmodp,polx[0]);
      tri = gsub(gsqr(var),gmul(divii(gmulsg(3, c4), p2),unmodp));
      tri = gsub(gmul(tri, var),
		 gmul(divii(gmul2n(c6,1), mulii(p2,p1)),unmodp));
      xun = gmodulcp(var,tri);
      c = lgef(ggcd((GEN)(gsub(gpui(xun,p1,0),xun))[2], tri)) - 2;
      break;
    case  8: f = 2; kod = -4; /* IV*  */
      c = 2 + kronecker(gdiv(mulis(c6,-6), gpuigs(p1,4)), p1);
      break;
    case  9: f = 2; kod = -3; c = 2; break; /* III* */
    case 10: f = 2; kod = -2; c = 1; break; /* II*  */
    default: err(tater1);
  }
  return localreduction_result(av,f,kod,c,v);
}

/* renvoie a_{ k,l } avec les notations de Tate */
static int
aux(GEN ak, int p, int l)
{
  long av = avma, pl = p, res;
  while (--l) pl *= p;
  res = smodis(divis(ak, pl), p);
  avma = av; return res;
}

static int
aux2(GEN ak, int p, GEN pl)
{
  long av = avma, res;
  res = smodis(divii(ak, pl), p);
  avma = av;
  return res;
}

/* renvoie le nombre de racines distinctes du polynome XXX + aXX + bX + c
 * modulo p s'il y a une racine multiple, elle est renvoyee dans *mult
 */
static int
numroots3(int a, int b, int c, int p, int *mult)
{
  if (p == 2)
    if ((c + a * b) & 1) return 3;
    else { *mult = b; return (a + b) & 1 ? 2 : 1; }
  else
    if (a % 3) { *mult = a * b; return (a * b * (1 - b) + c) % 3 ? 3 : 2; }
    else { *mult = -c; return b % 3 ? 3 : 1; }
}

/* idem pour aXX +bX + c */
static int
numroots2(int a, int b, int c, int p, int *mult)
{
  if (p == 2) { *mult = c; return b & 1 ? 2 : 1; }
  else { *mult = a * b; return (b * b - a * c) % 3 ? 2 : 1; }
}

/* ici, p1 = 2 ou p1 = 3 */
static GEN
localreduction_carac_23(GEN e, GEN p1)
{
  long av = avma, p, c, nu, nudelta;
  int a21, a42, a63, a32, a64, theroot, al, be, ga;
  GEN pk, p2k, pk1, p4, p6;
  GEN p2, p3, r = gzero, s = gzero, t = gzero, v;

  nudelta = ggval((GEN)e[12], p1);
  v = cgetg(5,t_VEC); v[1] = un; v[2] = v[3] = v[4] = zero;

  for(;;)
  {
    if (!nudelta)
      return localreduction_result(av, 0, 1, 1, v);
	/* I0   */
    p = itos(p1);
    if (!divise((GEN)e[6], p1))
    {
      if (smodis(gneg((GEN)e[11]), p == 2 ? 8 : 3) == 1)
	c = nudelta;
      else
	c = 2 - (nudelta & 1);
      return localreduction_result(av, 1, 4 + nudelta, c, v);
    }
	/* Inu  */
    if (p == 2)
    {
      r = modis((GEN)e[4], 2);
      s = modis(addii(r, (GEN)e[2]), 2);
      if (signe(r)) t = modis(addii(addii((GEN)e[4], (GEN)e[5]), s), 2);
      else t = modis((GEN)e[5], 2);
    }
    else /* p == 3 */
    {
      r = negi(modis((GEN)e[8], 3));
      s = modis((GEN)e[1], 3);
      t = modis(addii((GEN)e[3], mulii((GEN)e[1], r)), 3);
    }
    cumule(&v, &e, gun, r, s, t); /* p | a1, a2, a3, a4 et a6 */
    p2 = stoi(p*p);
    if (!divise((GEN)e[5], p2))
      return localreduction_result(av, nudelta, 2, 1, v);
	/* II   */
    p3 = stoi(p*p*p);
    if (!divise((GEN)e[9], p3))
      return localreduction_result(av, nudelta - 1, 3, 2, v);
	/* III  */
    if (!divise((GEN)e[8], p3))
    {
      if (smodis((GEN)e[8], (p==2)? 32: 27) == p*p)
	c = 3;
      else
	c = 1;
      return localreduction_result(av, nudelta - 2, 4, c, v);
    }
	/* IV   */

	/* now for the last five cases... */

    if (!divise((GEN)e[5], p3))
      cumule(&v, &e, gun, gzero, gzero, p == 2? gdeux: modis((GEN)e[3], 9));
	/* p | a1, a2; p^2  | a3, a4; p^3 | a6 */
    a21 = aux((GEN)e[2], p, 1); a42 = aux((GEN)e[4], p, 2);
    a63 = aux((GEN)e[5], p, 3);
    switch (numroots3(a21, a42, a63, p, &theroot))
    {
      case 3:
	if (p == 2)
	  c = 1 + (a63 == 0) + ((a21 + a42 + a63) & 1);
	else
	  c = 1 + (a63 == 0) + (((1 + a21 + a42 + a63) % 3) == 0)
	      + (((1 - a21 + a42 - a63) % 3) == 0);
	return localreduction_result(av, nudelta - 4, -1, c, v);
	    /* I0*  */
      case 2: /* calcul de nu */
	if (theroot) cumule(&v, &e, gun, stoi(theroot * p), gzero, gzero);
	    /* p | a1; p^2  | a2, a3; p^3 | a4; p^4 | a6 */
	nu = 1;
	pk = p2;
	p2k = stoi(p * p * p * p);
	for(;;)
	{
	  if (numroots2(al = 1, be = aux2((GEN)e[3], p, pk),
			ga = -aux2((GEN)e[5], p, p2k), p, &theroot) == 2)
	    break;
	  if (theroot) cumule(&v, &e, gun, gzero, gzero, mulsi(theroot,pk));
	  pk1 = pk; pk = mulsi(p, pk); p2k = mulsi(p, p2k);
	  nu++;
	  if (numroots2(al = a21, be = aux2((GEN)e[4], p, pk),
			ga = aux2((GEN)e[5], p, p2k), p, &theroot) == 2)
	    break;
	  if (theroot) cumule(&v, &e, gun, mulsi(theroot, pk1), gzero, gzero);
	  p2k = mulsi(p, p2k);
	  nu++;
	}
	if (p == 2)
	  c = 4 - 2 * (ga & 1);
	else
	  c = 3 + kross(be * be - al * ga, 3);
	return localreduction_result(av, nudelta - 4 - nu, -4 - nu, c, v);
	    /* Inu* */
      case 1:
	if (theroot) cumule(&v, &e, gun, stoi(theroot * p), gzero, gzero);
	    /* p | a1; p^2  | a2, a3; p^3 | a4; p^4 | a6 */
	a32 = aux((GEN)e[3], p, 2); a64 = aux((GEN)e[5], p, 4);
	if (numroots2(1, a32, -a64, p, &theroot) == 2)
	{
	  if (p == 2)
	    c = 3 - 2 * a64;
	  else
	    c = 2 + kross(a32 * a32 + a64, 3);
	  return localreduction_result(av, nudelta - 6, -4, c, v);
	}
	    /* IV*  */
	if (theroot) cumule(&v, &e, gun, gzero, gzero, stoi(theroot*p*p));
	    /* p | a1; p^2 | a2; p^3 | a3, a4; p^5 | a6 */
	p4 = sqri(p2);
	if (!divise((GEN)e[4], p4))
	  return localreduction_result(av, nudelta - 7, -3, 2, v);
	    /* III* */
	p6 = mulii(p4, p2);
	if (!divise((GEN)e[5], p6))
	  return localreduction_result(av, nudelta - 8, -2, 1, v);
	    /* II*  */
	cumule(&v, &e, p1, gzero, gzero, gzero); /* non minimal, on repart
						     pour un tour */
	nudelta -= 12;
    }
  }
  /* Not reached */
}

GEN
localreduction(GEN e, GEN p1)
{
  checkell(e);
  if (typ(e[12]) != t_INT)
    err(talker,"not an integral curve in localreduction");
  if (gcmpgs(p1, 3) > 0)       /* p different de 2 ou 3 */
    return localreduction_carac_not23(e,p1);
  else
    return localreduction_carac_23(e,p1);
}

#if 0
/*  Calcul de toutes les fibres non elliptiques d'une courbe sur Z.
 *  Etant donne une courbe elliptique sous forme longue e, dont les coefficients
 *  sont entiers, renvoie une matrice dont les lignes sont de la forme
 *  [p, fp, kodp, cp]. Il y a une ligne par diviseur premier du discriminant.
 */
GEN
globaltatealgo(GEN e)
{
  long k, l,av;
  GEN p1, p2, p3, p4, prims, result;

  checkell(e);
  prims = decomp((GEN)e[12]);
  l = lg(p1 = (GEN)prims[1]);
  p2 = (GEN)prims[2];
  if ((long)prims == avma) cgiv(prims);
  result = cgetg(5, t_MAT);
  result[1] = (long)p1;
  result[2] = (long)p2;
  result[3] = (long)(p3 = cgetg(l, t_COL));
  for (k = 1; k < l; k++) p3[k] = lgeti(3);
  result[4] = (long)(p4 = cgetg(l, t_COL));
  for (k = 1; k < l; k++) p4[k] = lgeti(3);
  av = avma;
  for (k = 1; k < l; k++)
  {
    GEN q = localreduction(e, (GEN)p1[k]);
    affii((GEN)q[1],(GEN)p2[k]);
    affii((GEN)q[2],(GEN)p3[k]);
    affii((GEN)q[4],(GEN)p4[k]);
    avma = av;
  }
  return result;
}
#endif

/* Algorithme de reduction d'une courbe sur Q a sa forme standard.  Etant
 * donne une courbe elliptique sous forme longue e, dont les coefficients
 * sont rationnels, renvoie son [N, [u, r, s, t], c], ou N est le conducteur
 * arithmetique de e, [u, r, s, t] est le changement de variables qui reduit
 * e a sa forme minimale globale dans laquelle a1 et a3 valent 0 ou 1, et a2
 * vaut -1, 0 ou 1 et tel que u est un rationnel positif. Enfin c est le
 * produit des nombres de Tamagawa locaux cp.
 */
GEN
globalreduction(GEN e1)
{
  long i, k, l, m, tetpil, av = avma;
  GEN p1, c = gun, prims, result, N = gun, u = gun, r, s, t;
  GEN v = cgetg(5, t_VEC), a = cgetg(7, t_VEC), e = cgetg(20, t_VEC);

  checkell(e1);
  for (i = 1; i < 5; i++) a[i] = e1[i]; a[5] = zero; a[6] = e1[5];
  prims = decomp(denom(a));
  l = lg(p1 = (GEN)prims[1]);
  for (k = 1; k < l; k++)
  {
    int n = 0;
    for (i = 1; i < 7; i++)
      if (!gcmp0((GEN)a[i]))
      {
	m = i * n + ggval((GEN)a[i], (GEN)p1[k]);
	while (m < 0) { n++; m += i; }
      }
    u = gmul(u, gpuigs((GEN)p1[k], n));
  }
  v[1] = linv(u); v[2] = v[3] = v[4] = zero;
  for (i = 1; i < 14; i++) e[i] = e1[i];
  for (; i < 20; i++) e[i] = zero;
  if (!gcmp1(u)) e = coordch(e, v);
  prims = decomp((GEN)e[12]);
  l = lg(p1 = (GEN)prims[1]);
  for (k = (signe(e[12]) < 0) + 1; k < l; k++)
  {
    GEN q = localreduction(e, (GEN)p1[k]);
    GEN v1 = (GEN)q[3];
    N = mulii(N, gpui((GEN)p1[k],(GEN)q[1],0));
    c = mulii(c, (GEN)q[4]);
    if (!gcmp1((GEN)v1[1])) cumule1(&v, &e, v1);
  }
  s = gdiventgs((GEN)e[1], -2);
  r = gdiventgs(gaddgs(gsub(gsub((GEN)e[2], gmul(s,(GEN)e[1])), gsqr(s)), 1), -3);
  t = gdiventgs(gadd((GEN)e[3], gmul(r,(GEN)e[1])), -2);
  cumule(&v, &e, gun, r, s, t);
  tetpil = avma;
  result = cgetg(4, t_VEC); result[1] = lcopy(N); result[2] = lcopy(v);
  result[3] = lcopy(c);
  return gerepile(av, tetpil, result);
}

/* cumule les effets de plusieurs chgts de variable. On traite a part les cas
 * particuliers frequents, tels que soit u = 1, soit r' = s' = t' = 0
 */
static void
cumulev(GEN *vtotal, GEN u, GEN r, GEN s, GEN t)
{
  long av = avma, tetpil;
  GEN temp, v = *vtotal, v3 = cgetg(5, t_VEC);
  if (gcmp1((GEN)v[1]))
  {
    v3[1] = lcopy(u);
    v3[2] = ladd((GEN)v[2], r);
    v3[3] = ladd((GEN)v[3], s);
    av = avma;
    temp = gadd((GEN)v[4], gmul((GEN)v[3], r));
    tetpil = avma;
    v3[4] = lpile(av, tetpil, gadd(temp, t));
  }
  else if (gcmp0(r) && gcmp0(s) && gcmp0(t))
  {
    v3[1] = lmul((GEN)v[1], u);
    v3[2] = lcopy((GEN)v[2]);
    v3[3] = lcopy((GEN)v[3]);
    v3[4] = lcopy((GEN)v[4]);
  }
  else /* cas general */
  {
    v3[1] = lmul((GEN)v[1], u);
    temp = gsqr((GEN)v[1]);
    v3[2] = ladd(gmul(temp, r), (GEN)v[2]);
    v3[3] = ladd(gmul((GEN)v[1], s), (GEN)v[3]);
    v3[4] = ladd((GEN)v[4], gmul(temp, gadd(gmul((GEN)v[1], t), gmul((GEN)v[3], r))));

    tetpil = avma;
    v3 = gerepile(av, tetpil, gcopy(v3));
  }
  *vtotal = v3;
}

static void
cumule(GEN *vtotal, GEN *e, GEN u, GEN r, GEN s, GEN t)
{
  long av = avma, tetpil;
  GEN v2 = cgetg(5, t_VEC);
  v2[1] = (long)u; v2[2] = (long)r; v2[3] = (long)s; v2[4] = (long)t;
  tetpil = avma;
  *e = gerepile(av, tetpil, coordch(*e, v2));
  cumulev(vtotal, u, r, s, t);
}

static void
cumule1(GEN *vtotal, GEN *e, GEN v2)
{
  *e = coordch(*e, v2);
  cumulev(vtotal, (GEN)v2[1], (GEN)v2[2], (GEN)v2[3], (GEN)v2[4]);
}

/********************************************************************/
/**                                                                **/
/**                   Parametrisation modulaire                    **/
/**                                                                **/
/********************************************************************/

GEN
taniyama(GEN e)
{
  GEN v,w,c,d,s1,s2,s3;
  long n,m,av=avma,tetpil;

  checkell(e);
  v=cgetg(precdl+3,t_SER); v[1]=evalsigne(1)+HIGHVALPBIT-2; v[2]=un;
  c=gtoser(anell(e,precdl+1),0); setvalp(c,1);
  d=ginv(c); c=gsqr(d);
  for (n=-3; n<=precdl-4; n++)
  {
    if (n!=2)
    {
      s3=n?gzero:(GEN)e[7];
      if (n>-3) s3=gadd(s3,gmul((GEN)e[6],(GEN)v[n+4]));
      s2=gzero;
      for (m=-2; m<=n+1; m++)
	s2 = gadd(s2,gmulsg(m*(n+m),gmul((GEN)v[m+4],(GEN)c[n-m+4])));
      s2=gmul2n(s2,-1);
      s1=gzero;
      for (m=-1; m+m<=n; m++)
      {
	if (m+m==n) s1=gadd(s1,gsqr((GEN)v[m+4]));
	else s1=gadd(s1,gmul2n(gmul((GEN)v[m+4],(GEN)v[n-m+4]),1));
      }
      v[n+6]=ldivgs(gsub(gadd(gmulsg(6,s1),s3),s2),(n+2)*(n+1)-12);
    }
    else
    {
      setlg(v,9); v[8]=(long)polx[MAXVARN];
      w=deriv(v,0); setvalp(w,-2);
      s1=gadd((GEN)e[8],gmul(v,gadd(gmul2n((GEN)e[7],1),gmul(v,gadd((GEN)e[6],gmul2n(v,2))))));
      setlg(v,precdl+3);
      s2=gsub(s1,gmul(c,gsqr(w)));
      s2=gsubst((GEN)s2[2],MAXVARN,polx[0]);
      v[n+6]=lneg(gdiv((GEN)s2[2],(GEN)s2[3]));
    }
  }
  w=gsub(gmul(polx[0],gmul(d,deriv(v,0))),gcmp0((GEN)e[1])?(GEN)e[3]:gadd((GEN)e[3],gmul((GEN)e[1],v)));
  tetpil=avma; s1=cgetg(3,t_VEC); s1[1]=lcopy(v); s1[2]=lmul2n(w,-1);
  return gerepile(av,tetpil,s1);
}

/********************************************************************/
/**                                                                **/
/**                       Points de torsion                        **/
/**                                                                **/
/********************************************************************/

/* p is a polynomial of degree exactly 3 with integral coefficients
 * and leading term 4. Outputs the vector of rational roots of p
 */
static GEN
ratroot(GEN p)
{
  GEN v,a,ld;
  long i,t;

  i=2; while (!signe(p[i])) i++;
  if (i==5)
    { v=cgetg(2,t_VEC); v[1]=zero; return v; }
  if (i==4)
    { v=cgetg(3,t_VEC); v[1]=zero; v[2]=ldivgs((GEN)p[4],-4); return v; }

  v=cgetg(4,t_VEC); t=0; 
  if (i==3) v[++t]=zero;
  ld=divisors(gmul2n((GEN)p[i],2));
  for (i=1; i<lg(ld); i++)
  {
    a = gmul2n((GEN)ld[i],-2);
    if (!gsigne(gsubst(p,0,a))) v[++t]=(long)a;
    a = gneg(a);
    if (!gsigne(gsubst(p,0,a))) v[++t]=(long)a;
  }
  setlg(v,t+1); return v;
}

/* we assume e is defined over Q */
GEN
orderell(GEN e, GEN p)
{
  GEN p1;
  long av=avma,k;

  checkell(e); checkpt(p);
  k=typ(e[13]);
  if (k!=t_INT && !is_frac_t(k))
    err(impl,"orderell for nonrational elliptic curves");
  p1=p; k=1;
  for (k=1; k<16; k++)
  {
    if (lg(p1)<3) { avma=av; return stoi(k); }
    p1 = addell(e,p1,p);
  }
  avma=av; return gzero;
}

static int
is_new_torsion(GEN e, GEN v, GEN p, long t2)
{
  GEN pk = p, pkprec = NULL;
  long k,l;

  for (k=2; k<=6; k++)
  {
    pk=addell(e,pk,p);
    if (lg(pk)==2) return 1;

    for (l=2; l<=t2; l++)
      if (gegal((GEN)pk[1],gmael(v,l,1))) return 1;

    if (pkprec && lg(pkprec)>2)
      if (k<=5 && gegal((GEN)pk[1],(GEN)pkprec[1])) return 1;
    pkprec=pk;
  }
  return 0;
}

GEN
torsell(GEN e)
{
  GEN n,d,ld,pol,p1,lr,v,w;
  long i,j,nlr,t,t2,k,k2,av=avma,tetpil,av1;

  checkell(e); t=1; 
  v=cgetg(17,t_VEC); p1=cgetg(2,t_VEC); p1[1]=zero; v[1]=(long)p1;
  pol=gadd((GEN)e[8],gmul(polx[0],gadd(gmul2n((GEN)e[7],1),gmul(polx[0],gadd((GEN)e[6],gmul2n(polx[0],2))))));
  lr=ratroot(pol); nlr=lg(lr)-1;
  for (i=1; i<=nlr; i++)
  {
    p1=cgetg(3,t_VEC); p1[1]=lr[i];
    p1[2]=ldivgs(gadd(gmul((GEN)e[1],(GEN)lr[i]),(GEN)e[3]),-2);
    v[++t]=(long)p1;
  }
  t2=t;
  ld=factor(gabs((GEN)e[12],0)); n=stoi(4);
  for (i=1; i<lg(ld[1]); i++)
    n = gmul(n,gpui(gcoeff(ld,i,1),shifti(gcoeff(ld,i,2),-1),0));
  ld=divisors(n);
  for (j=1; j<lg(ld); j++)
  {
    d=(GEN)ld[j]; lr=ratroot(gsub(pol,gsqr(d)));
    for (i=1; i<lg(lr); i++)
    {
      p1 = cgetg(3,t_VEC);
      p1[1]=lr[i];
      p1[2]=lmul2n(gsub(d,gadd(gmul((GEN)e[1],(GEN)lr[i]),(GEN)e[3])),-1);
        
      if (is_new_torsion(e,v,p1,t2))
      {
        GEN p2 = cgetg(3,t_VEC);
        p2[1]=p1[1]; p2[2]=lsub((GEN)p1[2],d);
	v[++t]=(long)p1; v[++t]=(long)p2;
      }
    }
  }
  if (t==1)
  {
    avma=av; w=cgetg(4,t_VEC); w[1]=un;
    w[2]=lgetg(1,t_VEC); w[3]=lgetg(1,t_VEC);
    return w;
  }

  tetpil=avma; w=cgetg(4,t_VEC); w[1]=lstoi(t);
  if (nlr<3)
  {
    p1=cgetg(2,t_VEC); p1[1]=lstoi(t); w[2]=(long)p1;
    av1=avma;
    k=2; while (k<=t && itos(orderell(e,(GEN)v[k])) != t) k++;
    avma=av1;
    if (k>t) err(bugparier,"torsell (bug1)");
    p1=cgetg(2,t_VEC); p1[1]=lcopy((GEN)v[k]); w[3]=(long)p1;
    return gerepile(av,tetpil,w);
  }
  if (t&3) err(bugparier,"torsell (bug2)");

  p1=cgetg(3,t_VEC); t2=t>>1; p1[1]=lstoi(t2); p1[2]=(long)gdeux;
  w[2]=(long)p1; av1=avma;
  k=2; while (k<=t && itos(orderell(e,(GEN)v[k])) != t2) k++;
  if (k>t) err(bugparier,"torsell (bug3)");

  k2=2; p1=powell(e,(GEN)v[k],stoi(t>>2));
  if (lg(p1)==3 && gegal((GEN)v[2],p1)) k2++;
  avma=av1;
  p1=cgetg(3,t_VEC); p1[1]=lcopy((GEN)v[k]); p1[2]=lcopy((GEN)v[k2]);
  w[3]=(long)p1; return gerepile(av,tetpil,w);
}
