[BACK]Return to elliptic.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib / pari-2.2 / src / modules

Annotation of OpenXM_contrib/pari-2.2/src/modules/elliptic.c, Revision 1.1.1.1

1.1       noro        1: /* $Id: elliptic.c,v 1.28 2001/10/01 12:11:33 karim Exp $
                      2:
                      3: Copyright (C) 2000  The PARI group.
                      4:
                      5: This file is part of the PARI/GP package.
                      6:
                      7: PARI/GP is free software; you can redistribute it and/or modify it under the
                      8: terms of the GNU General Public License as published by the Free Software
                      9: Foundation. It is distributed in the hope that it will be useful, but WITHOUT
                     10: ANY WARRANTY WHATSOEVER.
                     11:
                     12: Check the License for details. You should have received a copy of it, along
                     13: with the package; see the file 'COPYING'. If not, write to the Free Software
                     14: Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
                     15:
                     16: /********************************************************************/
                     17: /**                                                                **/
                     18: /**                       ELLIPTIC CURVES                          **/
                     19: /**                                                                **/
                     20: /********************************************************************/
                     21: #include "pari.h"
                     22:
                     23: void
                     24: checkpt(GEN z)
                     25: {
                     26:   if (typ(z)!=t_VEC) err(elliper1);
                     27: }
                     28:
                     29: long
                     30: checkell(GEN e)
                     31: {
                     32:   long lx=lg(e);
                     33:   if (typ(e)!=t_VEC || lx<14) err(elliper1);
                     34:   return lx;
                     35: }
                     36:
                     37: void
                     38: checkbell(GEN e)
                     39: {
                     40:   if (typ(e)!=t_VEC || lg(e)<20) err(elliper1);
                     41: }
                     42:
                     43: void
                     44: checksell(GEN e)
                     45: {
                     46:   if (typ(e)!=t_VEC || lg(e)<6) err(elliper1);
                     47: }
                     48:
                     49: static void
                     50: checkch(GEN z)
                     51: {
                     52:   if (typ(z)!=t_VEC || lg(z)!=5) err(elliper1);
                     53: }
                     54:
                     55: /* 4 X^3 + b2 X^2 + 2b4 X + b6 */
                     56: static GEN
                     57: RHSpol(GEN e)
                     58: {
                     59:   GEN z = cgetg(6, t_POL); z[1] = evalsigne(1)|evallgef(6);
                     60:   z[2] = e[8];
                     61:   z[3] = lmul2n((GEN)e[7],1);
                     62:   z[4] = e[6];
                     63:   z[5] = lstoi(4); return z;
                     64: }
                     65:
                     66: /* x^3 + a2 x^2 + a4 x + a6 */
                     67: static GEN
                     68: ellRHS(GEN e, GEN x)
                     69: {
                     70:   GEN p1;
                     71:   p1 = gadd((GEN)e[2],x);
                     72:   p1 = gadd((GEN)e[4], gmul(x,p1));
                     73:   p1 = gadd((GEN)e[5], gmul(x,p1));
                     74:   return p1;
                     75: }
                     76:
                     77: /* a1 x + a3 */
                     78: static GEN
                     79: ellLHS0(GEN e, GEN x)
                     80: {
                     81:   return gcmp0((GEN)e[1])? (GEN)e[3]: gadd((GEN)e[3], gmul(x,(GEN)e[1]));
                     82: }
                     83:
                     84: static GEN
                     85: ellLHS0_i(GEN e, GEN x)
                     86: {
                     87:   return signe(e[1])? addii((GEN)e[3], mulii(x, (GEN)e[1])): (GEN)e[3];
                     88: }
                     89:
                     90: /* y^2 + a1 xy + a3 y */
                     91: static GEN
                     92: ellLHS(GEN e, GEN z)
                     93: {
                     94:   GEN y = (GEN)z[2];
                     95:   return gmul(y, gadd(y, ellLHS0(e,(GEN)z[1])));
                     96: }
                     97:
                     98: /* 2y + a1 x + a3 */
                     99: static GEN
                    100: d_ellLHS(GEN e, GEN z)
                    101: {
                    102:   return gadd(ellLHS0(e, (GEN)z[1]), gmul2n((GEN)z[2],1));
                    103: }
                    104:
                    105: static void
                    106: smallinitell0(GEN x, GEN y)
                    107: {
                    108:   GEN b2,b4,b6,b8,d,j,a11,a13,a33,a64,b81,b22,c4,c6;
                    109:   long i;
                    110:
                    111:   checksell(x); for (i=1; i<=5; i++) y[i]=x[i];
                    112:
                    113:   b2=gadd(a11=gsqr((GEN)y[1]),gmul2n((GEN)y[2],2));
                    114:   y[6]=(long)b2;
                    115:
                    116:   b4=gadd(a13=gmul((GEN)y[1],(GEN)y[3]),gmul2n((GEN)y[4],1));
                    117:   y[7]=(long)b4;
                    118:
                    119:   b6=gadd(a33=gsqr((GEN)y[3]),a64=gmul2n((GEN)y[5],2));
                    120:   y[8]=(long)b6;
                    121:
                    122:   b81=gadd(gadd(gmul(a11,(GEN)y[5]),gmul(a64,(GEN)y[2])),gmul((GEN)y[2],a33));
                    123:   b8=gsub(b81,gmul((GEN)y[4],gadd((GEN)y[4],a13)));
                    124:   y[9]=(long)b8;
                    125:
                    126:   c4=gadd(b22=gsqr(b2),gmulsg(-24,b4));
                    127:   y[10]=(long)c4;
                    128:
                    129:   c6=gadd(gmul(b2,gsub(gmulsg(36,b4),b22)),gmulsg(-216,b6));
                    130:   y[11]=(long)c6;
                    131:
                    132:   b81=gadd(gmul(b22,b8),gmulsg(27,gsqr(b6)));
                    133:   d=gsub(gmul(b4,gadd(gmulsg(9,gmul(b2,b6)),gmulsg(-8,gsqr(b4)))),b81);
                    134:   y[12]=(long)d;
                    135:
                    136:   if (gcmp0(d)) err(talker,"singular curve in ellinit");
                    137:
                    138:   j = gdiv(gmul(gsqr(c4),c4),d);
                    139:   y[13]=(long)j;
                    140: }
                    141:
                    142: GEN
                    143: smallinitell(GEN x)
                    144: {
                    145:   ulong av = avma;
                    146:   GEN y = cgetg(14,t_VEC);
                    147:   smallinitell0(x,y); return gerepilecopy(av,y);
                    148: }
                    149:
                    150: GEN
                    151: ellinit0(GEN x, long flag,long prec)
                    152: {
                    153:   switch(flag)
                    154:   {
                    155:     case 0: return initell(x,prec);
                    156:     case 1: return smallinitell(x);
                    157:     default: err(flagerr,"ellinit");
                    158:   }
                    159:   return NULL; /* not reached */
                    160: }
                    161:
                    162: void
                    163: ellprint(GEN e)
                    164: {
                    165:   long av = avma;
                    166:   long vx = fetch_var();
                    167:   long vy = fetch_var();
                    168:   GEN z = cgetg(3,t_VEC);
                    169:   if (typ(e) != t_VEC || lg(e) < 6)
                    170:     err(talker, "not an elliptic curve in ellprint");
                    171:   z[1] = lpolx[vx]; name_var(vx, "X");
                    172:   z[2] = lpolx[vy]; name_var(vy, "Y");
                    173:   fprintferr("%Z = %Z\n", ellLHS(e, z), ellRHS(e, polx[vx]));
                    174:   (void)delete_var();
                    175:   (void)delete_var(); avma = av;
                    176: }
                    177:
                    178: static GEN
                    179: do_agm(GEN *ptx1, GEN a1, GEN b1, long prec, long sw)
                    180: {
                    181:   GEN p1,r1,a,b,x,x1;
                    182:   long G;
                    183:
                    184:   x1 = gmul2n(gsub(a1,b1),-2);
                    185:   if (gcmp0(x1))
                    186:     err(precer,"initell");
                    187:   G = 6 - bit_accuracy(prec);
                    188:   for(;;)
                    189:   {
                    190:     a=a1; b=b1; x=x1;
                    191:     b1=gsqrt(gmul(a,b),prec); setsigne(b1,sw);
                    192:     a1=gmul2n(gadd(gadd(a,b),gmul2n(b1,1)),-2);
                    193:     r1=gsub(a1,b1);
                    194:     p1=gsqrt(gdiv(gadd(x,r1),x),prec);
                    195:     x1=gmul(x,gsqr(gmul2n(gaddsg(1,p1),-1)));
                    196:     if (gcmp0(r1) || gexpo(r1) <= G + gexpo(b1)) break;
                    197:   }
                    198:   if (gprecision(x1)*2 <= (prec+2))
                    199:     err(precer,"initell");
                    200:   *ptx1 = x1; return ginv(gmul2n(a1,2));
                    201: }
                    202:
                    203: static GEN
                    204: do_padic_agm(GEN *ptx1, GEN a1, GEN b1, GEN p)
                    205: {
                    206:   GEN p1,r1,a,b,x,bmod1, bmod = modii((GEN)b1[4],p), x1 = *ptx1;
                    207:
                    208:   if (!x1) x1 = gmul2n(gsub(a1,b1),-2);
                    209:   for(;;)
                    210:   {
                    211:     a=a1; b=b1; x=x1;
                    212:     b1=gsqrt(gmul(a,b),0); bmod1=modii((GEN)b1[4],p);
                    213:     if (!egalii(bmod1,bmod)) b1 = gneg_i(b1);
                    214:     a1=gmul2n(gadd(gadd(a,b),gmul2n(b1,1)),-2);
                    215:     r1=gsub(a1,b1);
                    216:     p1=gsqrt(gdiv(gadd(x,r1),x),0);
                    217:     if (! gcmp1(modii((GEN)p1[4],p))) p1 = gneg_i(p1);
                    218:     x1=gmul(x,gsqr(gmul2n(gaddsg(1,p1),-1)));
                    219:     if (gcmp0(r1)) break;
                    220:   }
                    221:   *ptx1 = x1; return ginv(gmul2n(a1,2));
                    222: }
                    223:
                    224: static GEN
                    225: padic_initell(GEN y, GEN p, long prec)
                    226: {
                    227:   GEN b2,b4,c4,c6,p1,p2,w,pv,a1,b1,x1,u2,q,e0,e1;
                    228:   long i,alpha;
                    229:
                    230:   if (valp(y[13]) >= 0) /* p | j */
                    231:     err(talker,"valuation of j must be negative in p-adic ellinit");
                    232:   if (egalii(p,gdeux))
                    233:     err(impl,"initell for 2-adic numbers"); /* pv=stoi(4); */
                    234:
                    235:   pv=p; q=ggrandocp(p,prec);
                    236:   for (i=1; i<=5; i++) y[i]=ladd(q,(GEN)y[i]);
                    237:   b2= (GEN)y[6];
                    238:   b4= (GEN)y[7];
                    239:   c4= (GEN)y[10];
                    240:   c6= (GEN)y[11];
                    241:   alpha=valp(c4)>>1;
                    242:   setvalp(c4,0);
                    243:   setvalp(c6,0); e1=gdivgs(gdiv(c6,c4),6);
                    244:   c4=gdivgs(c4,48); c6=gdivgs(c6,864);
                    245:   do
                    246:   {
                    247:     e0=e1; p2=gsqr(e0);
                    248:     e1=gdiv(gadd(gmul2n(gmul(e0,p2),1),c6), gsub(gmulsg(3,p2),c4));
                    249:   }
                    250:   while (!gegal(e0,e1));
                    251:   setvalp(e1,valp(e1)+alpha);
                    252:
                    253:   e1=gsub(e1,gdivgs(b2,12));
                    254:   w=gsqrt(gmul2n(gadd(b4,gmul(e1,gadd(b2,gmulsg(6,e1)))),1),0);
                    255:
                    256:   p1=gaddgs(gdiv(gmulsg(3,e0),w),1);
                    257:   if (valp(p1)<=0) w=gneg_i(w);
                    258:   y[18]=(long)w;
                    259:
                    260:   a1=gmul2n(gsub(w,gadd(gmulsg(3,e1),gmul2n(b2,-2))),-2);
                    261:   b1=gmul2n(w,-1); x1=NULL;
                    262:   u2 = do_padic_agm(&x1,a1,b1,pv);
                    263:
                    264:   w = gaddsg(1,ginv(gmul2n(gmul(u2,x1),1)));
                    265:   w = gadd(w,gsqrt(gaddgs(gsqr(w),-1),0));
                    266:   if (gcmp0(w)) err(precer,"initell");
                    267:   q=ginv(w);
                    268:   if (valp(q)<0) q=ginv(q);
                    269:
                    270:   p1=cgetg(2,t_VEC); p1[1]=(long)e1;
                    271:   y[14]=(long)p1;
                    272:   y[15]=(long)u2;
                    273:   y[16] = (kronecker((GEN)u2[4],p) <= 0 || (valp(u2)&1))? zero: lsqrt(u2,0);
                    274:   y[17]=(long)q;
                    275:   y[19]=zero; return y;
                    276: }
                    277:
                    278: static int
                    279: invcmp(GEN x, GEN y) { return -gcmp(x,y); }
                    280:
                    281: static GEN
                    282: initell0(GEN x, long prec)
                    283: {
                    284:   GEN b2,b4,D,p1,p2,p,w,a1,b1,x1,u2,q,e1,pi,pi2,tau,w1,w2;
                    285:   GEN y = cgetg(20,t_VEC);
                    286:   long ty,i,e,sw;
                    287:
                    288:   smallinitell0(x,y);
                    289:
                    290:   e = BIGINT; p = NULL;
                    291:   for (i=1; i<=5; i++)
                    292:   {
                    293:     q = (GEN)y[i];
                    294:     if (typ(q)==t_PADIC)
                    295:     {
                    296:       long e2 = signe(q[4])? precp(q)+valp(q): valp(q);
                    297:       if (e2 < e) e = e2;
                    298:       if (!p) p = (GEN)q[2];
                    299:       else if (!egalii(p,(GEN)q[2]))
                    300:         err(talker,"incompatible p-adic numbers in initell");
                    301:     }
                    302:   }
                    303:   if (e<BIGINT) return padic_initell(y,p,e);
                    304:
                    305:   b2= (GEN)y[6];
                    306:   b4= (GEN)y[7];
                    307:   D = (GEN)y[12]; ty = typ(D);
                    308:   if (!prec || !is_const_t(ty) || ty==t_INTMOD)
                    309:     { y[14]=y[15]=y[16]=y[17]=y[18]=y[19]=zero; return y; }
                    310:
                    311:   p1 = roots(RHSpol(y),prec);
                    312:   if (gsigne(D) < 0) p1[1] = lreal((GEN)p1[1]);
                    313:   else /* sort roots in decreasing order */
                    314:     p1 = gen_sort(greal(p1), 0, invcmp);
                    315:   y[14]=(long)p1;
                    316:
                    317:   e1 = (GEN)p1[1];
                    318:   w  = gsqrt(gmul2n(gadd(b4,gmul(e1,gadd(b2,gmulsg(6,e1)))),1),prec);
                    319:   p2 = gadd(gmulsg(3,e1), gmul2n(b2,-2));
                    320:   if (gsigne(p2) > 0) w = gneg_i(w);
                    321:   a1 = gmul2n(gsub(w,p2),-2);
                    322:   b1 = gmul2n(w,-1); sw = signe(w);
                    323:   u2 = do_agm(&x1,a1,b1,prec,sw);
                    324:
                    325:   w = gaddsg(1,ginv(gmul2n(gmul(u2,x1),1)));
                    326:   q = gsqrt(gaddgs(gsqr(w),-1),prec);
                    327:   if (gsigne(greal(w))>0)
                    328:     q = ginv(gadd(w,q));
                    329:   else
                    330:     q = gsub(w,q);
                    331:   if (gexpo(q) >= 0) q = ginv(q);
                    332:   pi = mppi(prec); pi2 = gmul2n(pi,1);
                    333:   tau = gmul(gdiv(glog(q,prec),pi2), gneg_i(gi));
                    334:
                    335:   y[19] = lmul(gmul(gsqr(pi2),gabs(u2,prec)), gimag(tau));
                    336:   w1 = gmul(pi2,gsqrt(gneg_i(u2),prec));
                    337:   w2 = gmul(tau,w1);
                    338:   if (sw < 0)
                    339:     q = gsqrt(q,prec);
                    340:   else
                    341:   {
                    342:     w1= gmul2n(gabs((GEN)w2[1],prec),1);
                    343:     q = gexp(gmul2n(gmul(gmul(pi2,gi),gdiv(w2,w1)), -1), prec);
                    344:   }
                    345:   y[15] = (long)w1;
                    346:   y[16] = (long)w2;
                    347:   p1 = gdiv(gsqr(pi),gmulsg(6,w1));
                    348:   p2 = thetanullk(q,1,prec);
                    349:   if (gcmp0(p2)) err(precer,"initell");
                    350:   y[17] = lmul(p1,gdiv(thetanullk(q,3,prec),p2));
                    351:   y[18] = ldiv(gsub(gmul((GEN)y[17],w2),gmul(gi,pi)), w1);
                    352:   return y;
                    353: }
                    354:
                    355: GEN
                    356: initell(GEN x, long prec)
                    357: {
                    358:   ulong av = avma;
                    359:   return gerepilecopy(av, initell0(x,prec));
                    360: }
                    361:
                    362: GEN
                    363: coordch(GEN e, GEN ch)
                    364: {
                    365:   GEN y,p1,p2,v,v2,v3,v4,v6,r,s,t,u;
                    366:   long i,lx = checkell(e);
                    367:   ulong av = avma;
                    368:
                    369:   checkch(ch);
                    370:   u=(GEN)ch[1]; r=(GEN)ch[2]; s=(GEN)ch[3]; t=(GEN)ch[4];
                    371:   y=cgetg(lx,t_VEC);
                    372:   v=ginv(u); v2=gsqr(v); v3=gmul(v,v2);v4=gsqr(v2); v6=gsqr(v3);
                    373:   y[1] = lmul(v,gadd((GEN)e[1],gmul2n(s,1)));
                    374:   y[2] = lmul(v2,gsub(gadd((GEN)e[2],gmulsg(3,r)),gmul(s,gadd((GEN)e[1],s))));
                    375:   p2 = ellLHS0(e,r);
                    376:   p1 = gadd(gmul2n(t,1), p2);
                    377:   y[3] = lmul(v3,p1);
                    378:   p1 = gsub((GEN)e[4],gadd(gmul(t,(GEN)e[1]),gmul(s,p1)));
                    379:   y[4] = lmul(v4,gadd(p1,gmul(r,gadd(gmul2n((GEN)e[2],1),gmulsg(3,r)))));
                    380:   p2 = gmul(t,gadd(t, p2));
                    381:   y[5] = lmul(v6,gsub(ellRHS(e,r),p2));
                    382:   y[6] = lmul(v2,gadd((GEN)e[6],gmulsg(12,r)));
                    383:   y[7] = lmul(v4,gadd((GEN)e[7],gmul(r,gadd((GEN)e[6],gmulsg(6,r)))));
                    384:   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)))))));
                    385:   p1 = gadd(gmulsg(3,(GEN)e[7]),gmul(r,gadd((GEN)e[6],gmulsg(3,r))));
                    386:   y[9] = lmul(gsqr(v4),gadd((GEN)e[9],gmul(r,gadd(gmulsg(3,(GEN)e[8]),gmul(r,p1)))));
                    387:   y[10] = lmul(v4,(GEN)e[10]);
                    388:   y[11] = lmul(v6,(GEN)e[11]);
                    389:   y[12] = lmul(gsqr(v6),(GEN)e[12]);
                    390:   y[13] = e[13];
                    391:   if (lx>14)
                    392:   {
                    393:     p1=(GEN)e[14];
                    394:     if (gcmp0(p1))
                    395:     {
                    396:       y[14] = y[15] = y[16] = y[17] = y[18] = y[19] = zero;
                    397:     }
                    398:     else
                    399:     {
                    400:       if (typ(e[1])==t_PADIC)
                    401:       {
                    402:         p2=cgetg(2,t_VEC); p2[1]=lmul(v2,gsub((GEN)p1[1],r));
                    403:         y[14]=(long)p2;
                    404:         y[15]=lmul(gsqr(u),(GEN)e[15]);
                    405:         y[16]=lmul(u,(GEN)e[16]);
                    406: /* FIXME: how do q and w change ??? */
                    407:         y[17]=e[17];
                    408:         y[18]=e[18];
                    409:         y[19]=zero;
                    410:       }
                    411:       else
                    412:       {
                    413:         p2=cgetg(4,t_COL);
                    414:         for (i=1; i<=3; i++) p2[i]=lmul(v2,gsub((GEN)p1[i],r));
                    415:         y[14]=(long)p2;
                    416:         y[15]=lmul(u,(GEN)e[15]);
                    417:         y[16]=lmul(u,(GEN)e[16]);
                    418:         y[17]=ldiv((GEN)e[17],u);
                    419:         y[18]=ldiv((GEN)e[18],u);
                    420:         y[19]=lmul(gsqr(u),(GEN)e[19]);
                    421:       }
                    422:     }
                    423:   }
                    424:   return gerepilecopy(av,y);
                    425: }
                    426:
                    427: static GEN
                    428: pointch0(GEN x, GEN v2, GEN v3, GEN mor, GEN s, GEN t)
                    429: {
                    430:   GEN p1,z;
                    431:
                    432:   if (lg(x) < 3) return x;
                    433:
                    434:   z = cgetg(3,t_VEC); p1=gadd((GEN)x[1],mor);
                    435:   z[1] = lmul(v2,p1);
                    436:   z[2] = lmul(v3,gsub((GEN)x[2],gadd(gmul(s,p1),t)));
                    437:   return z;
                    438: }
                    439:
                    440: GEN
                    441: pointch(GEN x, GEN ch)
                    442: {
                    443:   GEN y,v,v2,v3,mor,r,s,t,u;
                    444:   long tx,lx=lg(x),i;
                    445:   ulong av = avma;
                    446:
                    447:   checkpt(x); checkch(ch);
                    448:   if (lx < 2) return gcopy(x);
                    449:   u=(GEN)ch[1]; r=(GEN)ch[2]; s=(GEN)ch[3]; t=(GEN)ch[4];
                    450:   tx=typ(x[1]); v=ginv(u); v2=gsqr(v); v3=gmul(v,v2); mor=gneg_i(r);
                    451:   if (is_matvec_t(tx))
                    452:   {
                    453:     y=cgetg(lx,tx);
                    454:     for (i=1; i<lx; i++)
                    455:       y[i]=(long) pointch0((GEN)x[i],v2,v3,mor,s,t);
                    456:   }
                    457:   else
                    458:     y = pointch0(x,v2,v3,mor,s,t);
                    459:   return gerepilecopy(av,y);
                    460: }
                    461:
                    462: /* Exactness of lhs and rhs in the following depends in non-obvious ways
                    463:    on the coeffs of the curve as well as on the components of the point z.
                    464:    Thus if e is exact, with a1==0, and z has exact y coordinate only, the
                    465:    lhs will be exact but the rhs won't. */
                    466: int
                    467: oncurve(GEN e, GEN z)
                    468: {
                    469:   GEN p1,p2,x;
                    470:   long av=avma,p,q;
                    471:
                    472:   checksell(e); checkpt(z); if (lg(z)<3) return 1; /* oo */
                    473:   p1 = ellLHS(e,z);
                    474:   p2 = ellRHS(e,(GEN)z[1]); x = gsub(p1,p2);
                    475:   if (gcmp0(x)) { avma=av; return 1; }
                    476:   p = precision(p1);
                    477:   q = precision(p2);
                    478:   if (!p && !q) { avma=av; return 0; } /* both of p1, p2 are exact */
                    479:   if (!q || (p && p < q)) q = p; /* min among nonzero elts of {p,q} */
                    480:   q = (gexpo(x) < gexpo(p1) - bit_accuracy(q) + 15);
                    481:   avma = av; return q;
                    482: }
                    483:
                    484: GEN
                    485: addell(GEN e, GEN z1, GEN z2)
                    486: {
                    487:   GEN p1,p2,x,y,x1,x2,y1,y2;
                    488:   long av=avma,tetpil;
                    489:
                    490:   checksell(e); checkpt(z1); checkpt(z2);
                    491:   if (lg(z1)<3) return gcopy(z2);
                    492:   if (lg(z2)<3) return gcopy(z1);
                    493:
                    494:   x1=(GEN)z1[1]; y1=(GEN)z1[2];
                    495:   x2=(GEN)z2[1]; y2=(GEN)z2[2];
                    496:   if (x1 == x2 || gegal(x1,x2))
                    497:   { /* y1 = y2 or -LHS0-y2 */
                    498:     if (y1 != y2)
                    499:     {
                    500:       int eq;
                    501:       if (precision(y1) || precision(y2))
                    502:         eq = (gexpo(gadd(ellLHS0(e,x1),gadd(y1,y2))) >= gexpo(y1));
                    503:       else
                    504:         eq = gegal(y1,y2);
                    505:       if (!eq) { avma=av; y=cgetg(2,t_VEC); y[1]=zero; return y; }
                    506:     }
                    507:     p2 = d_ellLHS(e,z1);
                    508:     if (gcmp0(p2)) { avma=av; y=cgetg(2,t_VEC); y[1]=zero; return y; }
                    509:     p1 = gadd(gsub((GEN)e[4],gmul((GEN)e[1],y1)),
                    510:               gmul(x1,gadd(gmul2n((GEN)e[2],1),gmulsg(3,x1))));
                    511:   }
                    512:   else { p1=gsub(y2,y1); p2=gsub(x2,x1); }
                    513:   p1 = gdiv(p1,p2);
                    514:   x = gsub(gmul(p1,gadd(p1,(GEN)e[1])), gadd(gadd(x1,x2),(GEN)e[2]));
                    515:   y = gadd(gadd(y1, ellLHS0(e,x)), gmul(p1,gsub(x,x1)));
                    516:   tetpil=avma; p1=cgetg(3,t_VEC); p1[1]=lcopy(x); p1[2]=lneg(y);
                    517:   return gerepile(av,tetpil,p1);
                    518: }
                    519:
                    520: static GEN
                    521: invell(GEN e, GEN z)
                    522: {
                    523:   GEN p1;
                    524:
                    525:   if (lg(z)<3) return z;
                    526:   p1=cgetg(3,t_VEC); p1[1]=z[1];
                    527:   p1[2]=(long)gneg_i(gadd((GEN)z[2], ellLHS0(e,(GEN)z[1])));
                    528:   return p1;
                    529: }
                    530:
                    531: GEN
                    532: subell(GEN e, GEN z1, GEN z2)
                    533: {
                    534:   long av=avma,tetpil;
                    535:
                    536:   checksell(e); checkpt(z2);
                    537:   z2=invell(e,z2); tetpil=avma;
                    538:   return gerepile(av,tetpil,addell(e,z1,z2));
                    539: }
                    540:
                    541: GEN
                    542: ordell(GEN e, GEN x, long prec)
                    543: {
                    544:   long av=avma,td,i,lx,tx=typ(x);
                    545:   GEN D,a,b,d,pd,p1,y;
                    546:
                    547:   checksell(e);
                    548:   if (is_matvec_t(tx))
                    549:   {
                    550:     lx=lg(x); y=cgetg(lx,tx);
                    551:     for (i=1; i<lx; i++) y[i]=(long)ordell(e,(GEN)x[i],prec);
                    552:     return y;
                    553:   }
                    554:
                    555:   a=ellRHS(e,x);
                    556:   b=ellLHS0(e,x); /* y*(y+b) = a */
                    557:   D=gadd(gsqr(b),gmul2n(a,2)); td=typ(D);
                    558:   if (gcmp0(D))
                    559:   {
                    560:     b = gneg_i(b);
                    561:     y = cgetg(2,t_VEC);
                    562:     if (td == t_INTMOD && egalii((GEN)D[1], gdeux))
                    563:       y[1] = (long)gmodulss(gcmp0(a)?0:1, 2);
                    564:     else
                    565:       y[1] = lmul2n(b,-1);
                    566:     return gerepileupto(av,y);
                    567:   }
                    568:
                    569:   if (td==t_INT || is_frac_t(td))
                    570:   {
                    571:     pd = (td==t_INT)? NULL: (GEN)D[2];
                    572:     if (pd) D = mulii((GEN)D[1],pd);
                    573:     if (!carrecomplet(D,&d)) { avma=av; return cgetg(1,t_VEC); }
                    574:     if (pd) d = gdiv(d,pd);
                    575:   }
                    576:   else
                    577:   {
                    578:     if (td==t_INTMOD)
                    579:     {
                    580:       if (egalii((GEN)D[1],gdeux))
                    581:       {
                    582:         avma=av;
                    583:         if (!gcmp0(a)) return cgetg(1,t_VEC);
                    584:         y = cgetg(3,t_VEC);
                    585:         y[1] = (long)gmodulss(0,2);
                    586:         y[2] = (long)gmodulss(1,2); return y;
                    587:       }
                    588:       if (kronecker((GEN)D[2],(GEN)D[1]) == -1)
                    589:         { avma=av; return cgetg(1,t_VEC); }
                    590:     }
                    591:     d = gsqrt(D,prec);
                    592:   }
                    593:   p1=gsub(d,b); y = cgetg(3,t_VEC);
                    594:   y[1] = lmul2n(p1,-1);
                    595:   y[2] = lsub((GEN)y[1],d);
                    596:   return gerepileupto(av,y);
                    597: }
                    598:
                    599: static GEN
                    600: CM_powell(GEN e, GEN z, GEN n)
                    601: {
                    602:   GEN x,y,p0,p1,q0,q1,p2,q2,z1,z2,pol,grdx;
                    603:   long av=avma,tetpil,ln,ep,vn;
                    604:
                    605:   if (lg(z)<3) return gcopy(z);
                    606:   pol=(GEN)n[1];
                    607:   if (signe(discsr(pol))>=0)
                    608:     err(talker,"not a negative quadratic discriminant in CM");
                    609:   if (!gcmp1(denom((GEN)n[2])) || !gcmp1(denom((GEN)n[3])))
                    610:     err(impl,"powell for nonintegral CM exponent");
                    611:
                    612:   p1=gaddgs(gmul2n(gnorm(n),2),4);
                    613:   if (gcmpgs(p1,(((ulong)MAXULONG)>>1)) > 0)
                    614:     err(talker,"norm too large in CM");
                    615:   ln=itos(p1); vn=(ln-4)>>2;
                    616:   z1 = weipell(e,ln);
                    617:   z2 = gsubst(z1,0,gmul(n,polx[0]));
                    618:   grdx=gadd((GEN)z[1],gdivgs((GEN)e[6],12));
                    619:   p0=gzero; p1=gun;
                    620:   q0=gun; q1=gzero;
                    621:   do
                    622:   {
                    623:     GEN ss=gzero;
                    624:     do
                    625:     {
                    626:       ep=(-valp(z2))>>1; ss=gadd(ss,gmul((GEN)z2[2],gpuigs(polx[0],ep)));
                    627:       z2=gsub(z2,gmul((GEN)z2[2],gpuigs(z1,ep)));
                    628:     }
                    629:     while (valp(z2)<=0);
                    630:     p2=gadd(p0,gmul(ss,p1)); p0=p1; p1=p2;
                    631:     q2=gadd(q0,gmul(ss,q1)); q0=q1; q1=q2;
                    632:     if (!signe(z2)) break;
                    633:     z2=ginv(z2);
                    634:   }
                    635:   while (degpol(p1) < vn);
                    636:   if (degpol(p1) > vn || signe(z2))
                    637:     err(talker,"not a complex multiplication in powell");
                    638:   x=gdiv(p1,q1); y=gdiv(deriv(x,0),n);
                    639:   x=gsub(poleval(x,grdx), gdivgs((GEN)e[6],12));
                    640:   y=gsub(gmul(d_ellLHS(e,z),poleval(y,grdx)), ellLHS0(e,x));
                    641:   tetpil=avma; z=cgetg(3,t_VEC); z[1]=lcopy(x); z[2]=lmul2n(y,-1);
                    642:   return gerepile(av,tetpil,z);
                    643: }
                    644:
                    645: GEN
                    646: powell(GEN e, GEN z, GEN n)
                    647: {
                    648:   GEN y;
                    649:   long av=avma,i,j,tetpil,s;
                    650:   ulong m;
                    651:
                    652:   checksell(e); checkpt(z);
                    653:   if (typ(n)==t_QUAD) return CM_powell(e,z,n);
                    654:   if (typ(n)!=t_INT)
                    655:     err(impl,"powell for nonintegral or non CM exponents");
                    656:   if (lg(z)<3) return gcopy(z);
                    657:   s=signe(n);
                    658:   if (!s) { y=cgetg(2,t_VEC); y[1]=zero; return y; }
                    659:   if (s < 0) { n=negi(n); z = invell(e,z); }
                    660:   if (is_pm1(n)) return gerepilecopy(av,z);
                    661:
                    662:   y=cgetg(2,t_VEC); y[1]=zero;
                    663:   for (i=lgefint(n)-1; i>2; i--)
                    664:     for (m=n[i],j=0; j<BITS_IN_LONG; j++,m>>=1)
                    665:     {
                    666:       if (m&1) y = addell(e,y,z);
                    667:       z = addell(e,z,z);
                    668:     }
                    669:   for (m=n[2]; m>1; m>>=1)
                    670:   {
                    671:     if (m&1) y = addell(e,y,z);
                    672:     z = addell(e,z,z);
                    673:   }
                    674:   tetpil=avma; return gerepile(av,tetpil,addell(e,y,z));
                    675: }
                    676:
                    677: GEN
                    678: mathell(GEN e, GEN x, long prec)
                    679: {
                    680:   GEN y,p1,p2, *pdiag;
                    681:   long lx=lg(x),i,j,tx=typ(x);
                    682:   ulong av = avma;
                    683:
                    684:   if (!is_vec_t(tx)) err(elliper1);
                    685:   lx=lg(x); y=cgetg(lx,t_MAT); pdiag=(GEN*) new_chunk(lx);
                    686:   for (i=1; i<lx; i++)
                    687:   {
                    688:     pdiag[i]=ghell(e,(GEN)x[i],prec);
                    689:     y[i]=lgetg(lx,t_COL);
                    690:   }
                    691:   for (i=1; i<lx; i++)
                    692:   {
                    693:     p1=(GEN)y[i]; p1[i]=lmul2n(pdiag[i],1);
                    694:     for (j=i+1; j<lx; j++)
                    695:     {
                    696:       p2=ghell(e,addell(e,(GEN)x[i],(GEN)x[j]),prec);
                    697:       p2=gsub(p2, gadd(pdiag[i],pdiag[j]));
                    698:       p1[j]=(long)p2; coeff(y,i,j)=(long)p2;
                    699:     }
                    700:   }
                    701:   return gerepilecopy(av,y);
                    702: }
                    703:
                    704: static GEN
                    705: bilhells(GEN e, GEN z1, GEN z2, GEN h2, long prec)
                    706: {
                    707:   long lz1=lg(z1),tx,av=avma,tetpil,i;
                    708:   GEN y,p1,p2;
                    709:
                    710:   if (lz1==1) return cgetg(1,typ(z1));
                    711:
                    712:   tx=typ(z1[1]);
                    713:   if (!is_matvec_t(tx))
                    714:   {
                    715:     p1 = ghell(e,addell(e,z1,z2),prec);
                    716:     p2 = gadd(ghell(e,z1,prec),h2);
                    717:     tetpil=avma; return gerepile(av,tetpil,gsub(p1,p2));
                    718:   }
                    719:   y=cgetg(lz1,typ(z1));
                    720:   for (i=1; i<lz1; i++)
                    721:     y[i]=(long)bilhells(e,(GEN)z1[i],z2,h2,prec);
                    722:   return y;
                    723: }
                    724:
                    725: GEN
                    726: bilhell(GEN e, GEN z1, GEN z2, long prec)
                    727: {
                    728:   GEN p1,h2;
                    729:   long av=avma,tetpil,tz1=typ(z1),tz2=typ(z2);
                    730:
                    731:   if (!is_matvec_t(tz1) || !is_matvec_t(tz2)) err(elliper1);
                    732:   if (lg(z1)==1) return cgetg(1,tz1);
                    733:   if (lg(z2)==1) return cgetg(1,tz2);
                    734:
                    735:   tz1=typ(z1[1]); tz2=typ(z2[1]);
                    736:   if (is_matvec_t(tz2))
                    737:   {
                    738:     if (is_matvec_t(tz1))
                    739:       err(talker,"two vector/matrix types in bilhell");
                    740:     p1=z1; z1=z2; z2=p1;
                    741:   }
                    742:   h2=ghell(e,z2,prec); tetpil=avma;
                    743:   return gerepile(av,tetpil,bilhells(e,z1,z2,h2,prec));
                    744: }
                    745:
                    746: static GEN
                    747: new_coords(GEN e, GEN x, GEN *pta, GEN *ptb, long prec)
                    748: {
                    749:   GEN a,b,r0,r1,p1,p2,w, e1 = gmael(e,14,1), b2 = (GEN)e[6];
                    750:   long ty = typ(e[12]);
                    751:
                    752:   r0 = gmul2n(b2,-2);
                    753:   p2 = gadd(gmulsg(3,e1),r0);
                    754:   if (ty == t_PADIC)
                    755:     w = (GEN)e[18];
                    756:   else
                    757:   {
                    758:     GEN b4 = (GEN)e[7];
                    759:     if (!is_const_t(ty)) err(typeer,"zell");
                    760:
                    761:     /* w = sqrt(2b4 + 2b2 e1 + 12 e1^2) */
                    762:     w = gsqrt(gmul2n(gadd(b4, gmul(e1,gadd(b2,gmulsg(6,e1)))),1),prec);
                    763:     if (gsigne(greal(p2)) > 0) w = gneg_i(w);
                    764:   }
                    765:   a = gmul2n(gsub(w,p2),-2);
                    766:   b = gmul2n(w,-1);
                    767:   r1 = gsub(a,b);
                    768:   p1 = gadd(x, gmul2n(gadd(e1,r0),-1));
                    769:   p1 = gmul2n(p1,-1);
                    770:   p1 = gadd(p1, gsqrt(gsub(gsqr(p1), gmul(a,r1)), prec));
                    771:   *pta = a; *ptb = b;
                    772:   return gmul(p1,gsqr(gmul2n(gaddsg(1,gsqrt(gdiv(gadd(p1,r1),p1),prec)),-1)));
                    773: }
                    774:
                    775: GEN
                    776: zell(GEN e, GEN z, long prec)
                    777: {
                    778:   long av=avma,ty,sw,fl;
                    779:   GEN t,u,p1,p2,a,b,x1,u2,D = (GEN)e[12];
                    780:
                    781:   checkbell(e);
                    782:   if (!oncurve(e,z)) err(heller1);
                    783:   ty=typ(D);
                    784:   if (ty==t_INTMOD) err(typeer,"zell");
                    785:   if (lg(z)<3) return (ty==t_PADIC)? gun: gzero;
                    786:
                    787:   x1 = new_coords(e,(GEN)z[1],&a,&b,prec);
                    788:   if (ty==t_PADIC)
                    789:   {
                    790:     u2 = do_padic_agm(&x1,a,b,(GEN)D[2]);
                    791:     if (!gcmp0((GEN)e[16]))
                    792:     {
                    793:       t=gsqrt(gaddsg(1,gdiv(x1,a)),prec);
                    794:       t=gdiv(gaddsg(-1,t),gaddsg(1,t));
                    795:     }
                    796:     else t=gaddsg(2,ginv(gmul(u2,x1)));
                    797:     return gerepileupto(av,t);
                    798:   }
                    799:
                    800:   sw = gsigne(greal(b)); fl=0;
                    801:   for(;;) /* agm */
                    802:   {
                    803:     GEN a0=a, b0=b, x0=x1, r1;
                    804:
                    805:     b = gsqrt(gmul(a0,b0),prec);
                    806:     if (gsigne(greal(b)) != sw) b = gneg_i(b);
                    807:     a = gmul2n(gadd(gadd(a0,b0),gmul2n(b,1)),-2);
                    808:     r1 = gsub(a,b);
                    809:     if (gcmp0(r1) || gexpo(r1) < gexpo(a) - bit_accuracy(prec)) break;
                    810:     p1 = gsqrt(gdiv(gadd(x0,r1),x0),prec);
                    811:     x1 = gmul(x0,gsqr(gmul2n(gaddsg(1,p1),-1)));
                    812:     r1 = gsub(x1,x0);
                    813:     if (gcmp0(r1) || gexpo(r1) < gexpo(x1) - bit_accuracy(prec) + 5)
                    814:     {
                    815:       if (fl) break;
                    816:       fl = 1;
                    817:     }
                    818:     else fl = 0;
                    819:   }
                    820:   u = gdiv(x1,a); t = gaddsg(1,u);
                    821:   if (gcmp0(t) || gexpo(t) <  5 - bit_accuracy(prec))
                    822:     t = negi(gun);
                    823:   else
                    824:     t = gdiv(u,gsqr(gaddsg(1,gsqrt(t,prec))));
                    825:   u = gsqrt(ginv(gmul2n(a,2)),prec);
                    826:   t = gmul(u, glog(t,prec));
                    827:
                    828:   /* which square root? test the reciprocal function (pointell) */
                    829:   if (!gcmp0(t))
                    830:   {
                    831:     GEN z1,z2;
                    832:     int bad;
                    833:
                    834:     z1 = pointell(e,t,3); /* we don't need much precision */
                    835:     /* Either z = z1 (ok: keep t), or z = z2 (bad: t <-- -t) */
                    836:     z2 = invell(e, z1);
                    837:     bad = (gexpo(gsub(z,z1)) > gexpo(gsub(z,z2)));
                    838:     if (bad) t = gneg(t);
                    839:     if (DEBUGLEVEL)
                    840:     {
                    841:       if (DEBUGLEVEL>4)
                    842:       {
                    843:         fprintferr("  z  = %Z\n",z);
                    844:         fprintferr("  z1 = %Z\n",z1);
                    845:         fprintferr("  z2 = %Z\n",z2);
                    846:       }
                    847:       fprintferr("ellpointtoz: %s square root\n", bad? "bad": "good");
                    848:       flusherr();
                    849:     }
                    850:   }
                    851:   /* send t to the fundamental domain if necessary */
                    852:   p2 = gdiv(gimag(t),gmael(e,16,2));
                    853:   p1 = gsub(p2, gmul2n(gun,-2));
                    854:   if (gcmp(gabs(p1,prec),ghalf) >= 0)
                    855:     t = gsub(t, gmul((GEN)e[16],gfloor(gadd(p2,dbltor(0.1)))));
                    856:   if (gsigne(greal(t)) < 0) t = gadd(t,(GEN)e[15]);
                    857:   return gerepileupto(av,t);
                    858: }
                    859:
                    860: /* compute gamma in SL_2(Z) and t'=gamma(t) so that t' is in the usual
                    861:    fundamental domain. Internal function no check, no garbage. */
                    862: static GEN
                    863: getgamma(GEN *ptt)
                    864: {
                    865:   GEN t = *ptt,a,b,c,d,n,m,p1,p2,run;
                    866:
                    867:   run = gsub(realun(DEFAULTPREC), gpuigs(stoi(10),-8));
                    868:   a=d=gun; b=c=gzero;
                    869:   for(;;)
                    870:   {
                    871:     n = ground(greal(t));
                    872:     if (signe(n))
                    873:     { /* apply T^n */
                    874:       n = negi(n); t = gadd(t,n);
                    875:       a = addii(a, mulii(n,c));
                    876:       b = addii(b, mulii(n,d));
                    877:     }
                    878:     m = gnorm(t); if (gcmp(m,run) >= 0) break;
                    879:     t = gneg_i(gdiv(gconj(t),m)); /* apply S */
                    880:     p1=negi(c); c=a; a=p1;
                    881:     p1=negi(d); d=b; b=p1;
                    882:   }
                    883:   m=cgetg(3,t_MAT); *ptt = t;
                    884:   p1=cgetg(3,t_COL); m[1]=(long)p1;
                    885:   p2=cgetg(3,t_COL); m[2]=(long)p2;
                    886:   p1[1]=(long)a; p2[1]=(long)b;
                    887:   p1[2]=(long)c; p2[2]=(long)d; return m;
                    888: }
                    889:
                    890: static GEN
                    891: get_tau(GEN *ptom1, GEN *ptom2, GEN *ptga)
                    892: {
                    893:   GEN om1 = *ptom1, om2 = *ptom2, tau = gdiv(om1,om2);
                    894:   long s = gsigne(gimag(tau));
                    895:   if (!s)
                    896:     err(talker,"omega1 and omega2 R-linearly dependent in elliptic function");
                    897:   if (s < 0) { *ptom1=om2; *ptom2=om1; tau=ginv(tau); }
                    898:   *ptga = getgamma(&tau); return tau;
                    899: }
                    900:
                    901: static int
                    902: get_periods(GEN e, GEN *om1, GEN *om2)
                    903: {
                    904:   long tx = typ(e);
                    905:   if (is_vec_t(tx))
                    906:     switch(lg(e))
                    907:     {
                    908:       case  3: *om1=(GEN)e[1];  *om2=(GEN)e[2]; return 1;
                    909:       case 20: *om1=(GEN)e[16]; *om2=(GEN)e[15]; return 1;
                    910:     }
                    911:   return 0;
                    912: }
                    913:
                    914: extern GEN PiI2(long prec);
                    915:
                    916: /* computes the numerical values of eisenstein series. k is equal to a positive
                    917:    even integer. If k=4 or 6, computes g2 or g3. If k=2, or k>6 even,
                    918:    compute (2iPi/om2)^k*(1+2/zeta(1-k)*sum(n>=1,n^(k-1)q^n/(1-q^n)) with no
                    919:    constant factor. */
                    920: GEN
                    921: elleisnum(GEN om, long k, long flag, long prec)
                    922: {
                    923:   long av=avma,lim,av1;
                    924:   GEN om1,om2,p1,pii2,tau,q,y,qn,ga,court,asub = NULL; /* gcc -Wall */
                    925:
                    926:   if (k%2 || k<=0) err(talker,"k not a positive even integer in elleisnum");
                    927:   if (!get_periods(om, &om1, &om2)) err(typeer,"elleisnum");
                    928:   pii2 = PiI2(prec);
                    929:   tau = get_tau(&om1,&om2, &ga);
                    930:   if (k==2) asub=gdiv(gmul(pii2,mulsi(12,gcoeff(ga,2,1))),om2);
                    931:   om2=gadd(gmul(gcoeff(ga,2,1),om1),gmul(gcoeff(ga,2,2),om2));
                    932:   if (k==2) asub=gdiv(asub,om2);
                    933:   q=gexp(gmul(pii2,tau),prec);
                    934:   y=gzero; court=stoi(3);
                    935:   av1=avma; lim=stack_lim(av1,1); qn=gun; court[2]=0;
                    936:   for(;;)
                    937:   {
                    938:     court[2]++; qn=gmul(q,qn);
                    939:     p1=gdiv(gmul(gpuigs(court,k-1),qn),gsub(gun,qn));
                    940:     y=gadd(y,p1);
                    941:     if (gcmp0(p1) || gexpo(p1) <= - bit_accuracy(prec) - 5) break;
                    942:     if (low_stack(lim, stack_lim(av1,1)))
                    943:     {
                    944:       GEN *gptr[2]; gptr[0]=&y; gptr[1]=&qn;
                    945:       if(DEBUGMEM>1) err(warnmem,"elleisnum");
                    946:       gerepilemany(av1,gptr,2);
                    947:     }
                    948:   }
                    949:
                    950:   y=gadd(gun,gmul(gdiv(gdeux,gzeta(stoi(1-k),prec)),y));
                    951:   p1=gpuigs(gdiv(pii2,om2),k);
                    952:   y = gmul(p1,y);
                    953:   if (k==2) y=gsub(y,asub);
                    954:   else if (k==4 && flag) y=gdivgs(y,12);
                    955:   else if (k==6 && flag) y=gdivgs(y,216);
                    956:   return gerepileupto(av,y);
                    957: }
                    958:
                    959: /* compute eta1, eta2 */
                    960: GEN
                    961: elleta(GEN om, long prec)
                    962: {
                    963:   long av=avma;
                    964:   GEN e2,y1,y2,y;
                    965:
                    966:   e2 = gdivgs(elleisnum(om,2,0,prec),12);
                    967:   y2 = gmul((GEN)om[2],e2);
                    968:   y1 = gadd(gdiv(PiI2(prec),(GEN)om[2]), gmul((GEN)om[1],e2));
                    969:   y = cgetg(3,t_VEC);
                    970:   y[1] = lneg(y1);
                    971:   y[2] = lneg(y2); return gerepileupto(av, y);
                    972: }
                    973:
                    974: /* computes the numerical value of wp(z | om1 Z + om2 Z),
                    975:    If flall=1, compute also wp'. Reduce to the fundamental domain first. */
                    976: static GEN
                    977: weipellnumall(GEN om1, GEN om2, GEN z, long flall, long prec)
                    978: {
                    979:   long av=avma,tetpil,lim,av1,toadd;
                    980:   GEN p1,pii2,pii4,a,tau,q,u,y,yp,u1,u2,qn,v,ga;
                    981:
                    982:   pii2 = PiI2(prec);
                    983:   tau = get_tau(&om1,&om2, &ga);
                    984:   om2=gadd(gmul(gcoeff(ga,2,1),om1),gmul(gcoeff(ga,2,2),om2));
                    985:   z=gdiv(z,om2);
                    986:   a=ground(gdiv(gimag(z),gimag(tau))); z=gsub(z,gmul(a,tau));
                    987:   a=ground(greal(z)); z=gsub(z,a);
                    988:   if (gcmp0(z) || gexpo(z) < 5 - bit_accuracy(prec))
                    989:   {
                    990:     avma=av; v=cgetg(2,t_VEC); v[1]=zero; return v;
                    991:   }
                    992:
                    993:   q=gexp(gmul(pii2,tau),prec);
                    994:   u=gexp(gmul(pii2,z),prec);
                    995:   u1=gsub(gun,u); u2=gsqr(u1);
                    996:   y=gadd(gdivgs(gun,12),gdiv(u,u2));
                    997:   if (flall) yp=gdiv(gadd(gun,u),gmul(u1,u2));
                    998:   toadd=(long)ceil(9.065*gtodouble(gimag(z)));
                    999:
                   1000:   av1=avma; lim=stack_lim(av1,1); qn=q;
                   1001:   for(;;)
                   1002:   {
                   1003:     GEN p2,qnu,qnu1,qnu2,qnu3,qnu4;
                   1004:
                   1005:     qnu=gmul(qn,u); qnu1=gsub(gun,qnu); qnu2=gsqr(qnu1);
                   1006:     qnu3=gsub(qn,u); qnu4=gsqr(qnu3);
                   1007:     p1=gsub(gmul(u,gadd(ginv(qnu2),ginv(qnu4))),
                   1008:            gmul2n(ginv(gsqr(gsub(gun,qn))),1));
                   1009:     p1=gmul(qn,p1);
                   1010:     y=gadd(y,p1);
                   1011:     if (flall)
                   1012:     {
                   1013:       p2=gadd(gdiv(gadd(gun,qnu),gmul(qnu1,qnu2)),
                   1014:               gdiv(gadd(qn,u),gmul(qnu3,qnu4)));
                   1015:       p2=gmul(qn,p2);
                   1016:       yp=gadd(yp,p2);
                   1017:     }
                   1018:     qn=gmul(q,qn);
                   1019:     if (gexpo(qn) <= - bit_accuracy(prec) - 5 - toadd) break;
                   1020:     if (low_stack(lim, stack_lim(av1,1)))
                   1021:     {
                   1022:       GEN *gptr[3]; gptr[0]=&y; gptr[1]=&qn; gptr[2]=&yp;
                   1023:       if(DEBUGMEM>1) err(warnmem,"weipellnum");
                   1024:       gerepilemany(av1,gptr,flall?3:2);
                   1025:     }
                   1026:   }
                   1027:
                   1028:   pii2=gdiv(pii2,om2);
                   1029:   pii4=gsqr(pii2);
                   1030:   y = gmul(pii4,y);
                   1031:   if (flall) yp=gmul(u,gmul(gmul(pii4,pii2),yp));
                   1032:   tetpil=avma;
                   1033:   if (flall) { v=cgetg(3,t_VEC); v[1]=lcopy(y); v[2]=lmul2n(yp,-1); }
                   1034:   else v=gcopy(y);
                   1035:   return gerepile(av,tetpil,v);
                   1036: }
                   1037:
                   1038: GEN
                   1039: ellzeta(GEN om, GEN z, long prec)
                   1040: {
                   1041:   long av=avma,tetpil,lim,av1,toadd;
                   1042:   GEN zinit,om1,om2,p1,pii2,tau,q,u,y,u1,qn,ga,x1,x2,et;
                   1043:
                   1044:   if (!get_periods(om, &om1, &om2)) err(typeer,"ellzeta");
                   1045:   pii2 = PiI2(prec);
                   1046:   tau = get_tau(&om1,&om2, &ga);
                   1047:   om2=gadd(gmul(gcoeff(ga,2,1),om1),gmul(gcoeff(ga,2,2),om2));
                   1048:   om1=gmul(tau,om2); om=cgetg(3,t_VEC); om[1]=(long)om1; om[2]=(long)om2;
                   1049:   z=gdiv(z,om2);
                   1050:
                   1051:   x1=ground(gdiv(gimag(z),gimag(tau))); z=gsub(z,gmul(x1,tau));
                   1052:   x2=ground(greal(z)); z=gsub(z,x2); zinit=gmul(z,om2);
                   1053:   et=elleta(om,prec);
                   1054:   et=gadd(gmul(x1,(GEN)et[1]),gmul(x2,(GEN)et[2]));
                   1055:   if (gcmp0(z) || gexpo(z) < 5 - bit_accuracy(prec))
                   1056:   {
                   1057:     p1=ginv(zinit); tetpil=avma; return gerepile(av,tetpil,gadd(p1,et));
                   1058:   }
                   1059:   q=gexp(gmul(pii2,tau),prec);
                   1060:   u=gexp(gmul(pii2,z),prec);
                   1061:   u1=gsub(u,gun);
                   1062:   y=gdiv(gmul(gsqr(om2),elleisnum(om,2,0,prec)),pii2);
                   1063:   y=gadd(ghalf,gdivgs(gmul(z,y),-12));
                   1064:   y=gadd(y,ginv(u1));
                   1065:   toadd=(long)ceil(9.065*gtodouble(gimag(z)));
                   1066:   av1=avma; lim=stack_lim(av1,1); qn=q;
                   1067:   for(;;)
                   1068:   {
                   1069:     p1=gadd(gdiv(u,gsub(gmul(qn,u),gun)),ginv(gsub(u,qn)));
                   1070:     p1=gmul(qn,p1);
                   1071:     y=gadd(y,p1);
                   1072:     qn=gmul(q,qn);
                   1073:     if (gexpo(qn) <= - bit_accuracy(prec) - 5 - toadd) break;
                   1074:     if (low_stack(lim, stack_lim(av1,1)))
                   1075:     {
                   1076:       GEN *gptr[2]; gptr[0]=&y; gptr[1]=&qn;
                   1077:       if(DEBUGMEM>1) err(warnmem,"ellzeta");
                   1078:       gerepilemany(av1,gptr,2);
                   1079:     }
                   1080:   }
                   1081:
                   1082:   y=gmul(gdiv(pii2,om2),y);
                   1083:   tetpil=avma;
                   1084:   return gerepile(av,tetpil,gadd(y,et));
                   1085: }
                   1086:
                   1087: /* if flag=0, return ellsigma, otherwise return log(ellsigma) */
                   1088: GEN
                   1089: ellsigma(GEN om, GEN z, long flag, long prec)
                   1090: {
                   1091:   long av=avma,lim,av1,toadd;
                   1092:   GEN zinit,om1,om2,p1,pii2,tau,q,u,y,y1,u1,qn,ga,negu,uinv,x1,x2,et,etnew,uhalf;
                   1093:   int doprod = (flag >= 2);
                   1094:   int dolog = (flag & 1);
                   1095:
                   1096:   if (!get_periods(om, &om1, &om2)) err(typeer,"ellsigmaprod");
                   1097:   pii2 = PiI2(prec);
                   1098:   tau = get_tau(&om1,&om2, &ga);
                   1099:   om2=gadd(gmul(gcoeff(ga,2,1),om1),gmul(gcoeff(ga,2,2),om2));
                   1100:   om1=gmul(tau,om2); om=cgetg(3,t_VEC); om[1]=(long)om1; om[2]=(long)om2;
                   1101:   z=gdiv(z,om2);
                   1102:
                   1103:   x1=ground(gdiv(gimag(z),gimag(tau))); z=gsub(z,gmul(x1,tau));
                   1104:   x2=ground(greal(z)); z=gsub(z,x2); zinit=gmul(z,om2);
                   1105:   et=elleta(om,prec);
                   1106:   etnew=gadd(gmul(x1,(GEN)et[1]),gmul(x2,(GEN)et[2]));
                   1107:   etnew=gmul(etnew,gadd(gmul2n(gadd(gmul(x1,om1),gmul(x2,om2)),-1),zinit));
                   1108:   if (mpodd(x1) || mpodd(x2)) etnew=gadd(etnew,gmul2n(pii2,-1));
                   1109:   if (gexpo(z) < 5 - bit_accuracy(prec))
                   1110:   {
                   1111:     if (dolog)
                   1112:       return gerepileupto(av, gadd(etnew,glog(zinit,prec)));
                   1113:     else
                   1114:       return gerepileupto(av, gmul(gexp(etnew,prec),zinit));
                   1115:   }
                   1116:
                   1117:   y1 = gadd(etnew,gmul2n(gmul(gmul(z,zinit),(GEN)et[2]),-1));
                   1118:
                   1119:   /* 9.065 = 2*Pi/log(2) */
                   1120:   toadd = (long)ceil(9.065*fabs(gtodouble(gimag(z))));
                   1121:   uhalf = gexp(gmul(gmul2n(pii2,-1),z),prec);
                   1122:   u = gsqr(uhalf);
                   1123:   if (doprod)
                   1124:   { /* use product */
                   1125:     q=gexp(gmul(pii2,tau),prec);
                   1126:     uinv=ginv(u);
                   1127:     u1=gsub(uhalf,ginv(uhalf));
                   1128:     y=gdiv(gmul(om2,u1),pii2);
                   1129:     av1=avma; lim=stack_lim(av1,1); qn=q;
                   1130:     negu=stoi(-1);
                   1131:     for(;;)
                   1132:     {
                   1133:       p1=gmul(gadd(gmul(qn,u),negu),gadd(gmul(qn,uinv),negu));
                   1134:       p1=gdiv(p1,gsqr(gadd(qn,negu)));
                   1135:       y=gmul(y,p1);
                   1136:       qn=gmul(q,qn);
                   1137:       if (gexpo(qn) <= - bit_accuracy(prec) - 5 - toadd) break;
                   1138:       if (low_stack(lim, stack_lim(av1,1)))
                   1139:       {
                   1140:         GEN *gptr[2]; gptr[0]=&y; gptr[1]=&qn;
                   1141:         if(DEBUGMEM>1) err(warnmem,"ellsigma");
                   1142:         gerepilemany(av1,gptr,2);
                   1143:       }
                   1144:     }
                   1145:   }
                   1146:   else
                   1147:   { /* use sum */
                   1148:     GEN q8,qn2,urn,urninv;
                   1149:     long n;
                   1150:     q8=gexp(gmul2n(gmul(pii2,tau),-3),prec);
                   1151:     q=gpuigs(q8,8);
                   1152:     u=gneg_i(u); uinv=ginv(u);
                   1153:     y=gzero;
                   1154:     av1=avma; lim=stack_lim(av1,1); qn=q; qn2=gun;
                   1155:     urn=uhalf; urninv=ginv(uhalf);
                   1156:     for(n=0;;n++)
                   1157:     {
                   1158:       y=gadd(y,gmul(qn2,gsub(urn,urninv)));
                   1159:       qn2=gmul(qn,qn2);
                   1160:       qn=gmul(q,qn);
                   1161:       urn=gmul(urn,u); urninv=gmul(urninv,uinv);
                   1162:       if (gexpo(qn2) + n*toadd <= - bit_accuracy(prec) - 5) break;
                   1163:       if (low_stack(lim, stack_lim(av1,1)))
                   1164:       {
                   1165:         GEN *gptr[5]; gptr[0]=&y; gptr[1]=&qn; gptr[2]=&qn2; gptr[3]=&urn;
                   1166:         gptr[4]=&urninv;
                   1167:         if(DEBUGMEM>1) err(warnmem,"ellsigma");
                   1168:         gerepilemany(av1,gptr,5);
                   1169:       }
                   1170:     }
                   1171:
                   1172:     p1=gmul(q8,gmul(gdiv(gdiv((GEN)om[2],pii2),gpuigs(trueeta(tau,prec),3)),y));
                   1173:   }
                   1174:
                   1175:   if (dolog)
                   1176:     return gerepileupto(av, gadd(y1,glog(p1,prec)));
                   1177:   else
                   1178:     return gerepileupto(av, gmul(p1,gexp(y1,prec)));
                   1179: }
                   1180:
                   1181: GEN
                   1182: pointell(GEN e, GEN z, long prec)
                   1183: {
                   1184:   long av=avma,tetpil;
                   1185:   GEN y,yp,v,p1;
                   1186:
                   1187:   checkbell(e);
                   1188:   p1=weipellnumall((GEN)e[16],(GEN)e[15],z,1,prec);
                   1189:   if (lg(p1)==2) { avma=av; v=cgetg(2,t_VEC); v[1]=zero; return v; }
                   1190:   y = gsub((GEN)p1[1], gdivgs((GEN)e[6],12));
                   1191:   yp = gsub((GEN)p1[2], gmul2n(ellLHS0(e,y),-1));
                   1192:   tetpil=avma; v=cgetg(3,t_VEC); v[1]=lcopy(y); v[2]=lcopy(yp);
                   1193:   return gerepile(av,tetpil,v);
                   1194: }
                   1195:
                   1196: GEN
                   1197: weipell(GEN e, long prec)
                   1198: {
                   1199:   long av1,tetpil,precres,i,k,l;
                   1200:   GEN res,p1,s,t;
                   1201:
                   1202:   checkell(e); precres = 2*prec+2;
                   1203:   res=cgetg(precres,t_SER);
                   1204:   res[1] = evalsigne(1) | evalvalp(-2) | evalvarn(0);
                   1205:   if (!prec) { setsigne(res,0); return res; }
                   1206:   for (i=3; i<precres; i+=2) res[i]=zero;
                   1207:   switch(prec)
                   1208:   {
                   1209:     default: res[8]=ldivgs((GEN)e[11],6048);
                   1210:     case 3: res[6]=ldivgs((GEN)e[10],240);
                   1211:     case 2: res[4]=zero;
                   1212:     case 1: res[2]=un;
                   1213:     case 0: break;
                   1214:   }
                   1215:   for (k=4; k<prec; k++)
                   1216:   {
                   1217:     av1 = avma;
                   1218:     s = k&1? gzero: gsqr((GEN)res[k+2]);
                   1219:     t = gzero;
                   1220:     for (l=2; l+l<k; l++)
                   1221:       t = gadd(t, gmul((GEN)res[(l+1)<<1],(GEN)res[(k-l+1)<<1]));
                   1222:     p1=gmulsg(3,gadd(s,gmul2n(t,1)));
                   1223:     tetpil=avma;
                   1224:     p1=gdivgs(p1,(k-3)*(2*k+1));
                   1225:     res[(k+1)<<1] = lpile(av1,tetpil,p1);
                   1226:   }
                   1227:   return res;
                   1228: }
                   1229:
                   1230: GEN
                   1231: ellwp0(GEN om, GEN z, long flag, long prec, long PREC)
                   1232: {
                   1233:   GEN v,om1,om2;
                   1234:   long av = avma;
                   1235:
                   1236:   if (z==NULL) return weipell(om,PREC);
                   1237:   if (typ(z)==t_POL)
                   1238:   {
                   1239:     if (lgef(z) != 4 || !gcmp0((GEN)z[2]) || !gcmp1((GEN)z[3]))
                   1240:       err(talker,"expecting a simple variable in ellwp");
                   1241:     v = weipell(om,PREC); setvarn(v, varn(z));
                   1242:     return v;
                   1243:   }
                   1244:   if (!get_periods(om, &om1, &om2)) err(typeer,"ellwp");
                   1245:   switch(flag)
                   1246:   {
                   1247:     case 0: v=weipellnumall(om1,om2,z,0,prec);
                   1248:       if (typ(v)==t_VEC && lg(v)==2) { avma=av; v=gpuigs(z,-2); }
                   1249:       return v;
                   1250:     case 1: v=weipellnumall(om1,om2,z,1,prec);
                   1251:       if (typ(v)==t_VEC && lg(v)==2)
                   1252:       {
                   1253:         GEN p1 = gmul2n(gpuigs(z,3),1);
                   1254:         long tetpil=avma;
                   1255:         v=cgetg(3,t_VEC);
                   1256:        v[1]=lpuigs(z,-2);
                   1257:        v[2]=lneg(p1); return gerepile(av,tetpil,v);
                   1258:       }
                   1259:       return v;
                   1260:     case 2: return pointell(om,z,prec);
                   1261:     default: err(flagerr,"ellwp"); return NULL;
                   1262:   }
                   1263: }
                   1264:
                   1265: /* compute a_2 using Jacobi sum */
                   1266: static GEN
                   1267: _a_2(GEN e)
                   1268: {
                   1269:   long av = avma;
                   1270:   GEN unmodp = gmodulss(1,8);
                   1271:   ulong e6 = itos((GEN)gmul(unmodp,(GEN)e[6])[2]);
                   1272:   ulong e8 = itos((GEN)gmul(unmodp,(GEN)e[8])[2]);
                   1273:   ulong e72= itos((GEN)gmul(unmodp,gmul2n((GEN)e[7],1))[2]);
                   1274:   long s = kross(e8, 2) + kross(e8 + e72 + e6 + 4, 2);
                   1275:   avma = av; return stoi(-s);
                   1276: }
                   1277:
                   1278: /* a_p using Jacobi sums */
                   1279: static GEN
                   1280: apell2_intern(GEN e, ulong p)
                   1281: {
                   1282:   if (p == 2) return _a_2(e);
                   1283:   else
                   1284:   {
                   1285:     ulong av = avma, i;
                   1286:     GEN unmodp = gmodulss(1,p);
                   1287:     ulong e6 = itos((GEN)gmul(unmodp,(GEN)e[6])[2]);
                   1288:     ulong e8 = itos((GEN)gmul(unmodp,(GEN)e[8])[2]);
                   1289:     ulong e72= itos((GEN)gmul(unmodp,(GEN)e[7])[2]) << 1;
                   1290:     long s = kross(e8, p);
                   1291:
                   1292:     if (p < 757UL)
                   1293:       for (i=1; i<p; i++)
                   1294:         s += kross(e8 + i*(e72 + i*(e6 + (i<<2))), p);
                   1295:     else
                   1296:       for (i=1; i<p; i++)
                   1297:         s += kross(e8 + mulssmod(i, e72 + mulssmod(i, e6 + (i<<2), p), p), p);
                   1298:     avma=av; return stoi(-s);
                   1299:   }
                   1300: }
                   1301:
                   1302: GEN
                   1303: apell2(GEN e, GEN pp)
                   1304: {
                   1305:   checkell(e); if (typ(pp)!=t_INT) err(elliper1);
                   1306:   if (expi(pp) > 29)
                   1307:     err(talker,"prime too large in jacobi apell2, use apell instead");
                   1308:
                   1309:   return apell2_intern(e, (ulong)pp[2]);
                   1310: }
                   1311:
                   1312: GEN ellap0(GEN e, GEN p, long flag)
                   1313: {
                   1314:   return flag? apell2(e,p): apell(e,p);
                   1315: }
                   1316:
                   1317: /* invert all elements of x mod p using Montgomery's trick */
                   1318: GEN
                   1319: multi_invmod(GEN x, GEN p)
                   1320: {
                   1321:   long i, lx = lg(x);
                   1322:   GEN u,y = cgetg(lx, t_VEC);
                   1323:
                   1324:   y[1] = x[1];
                   1325:   for (i=2; i<lx; i++)
                   1326:     y[i] = lresii(mulii((GEN)y[i-1], (GEN)x[i]), p);
                   1327:
                   1328:   u = mpinvmod((GEN)y[--i], p);
                   1329:   for ( ; i > 1; i--)
                   1330:   {
                   1331:     y[i] = lresii(mulii(u, (GEN)y[i-1]), p);
                   1332:     u = resii(mulii(u, (GEN)x[i]), p); /* u = 1 / (x[1] ... x[i-1]) */
                   1333:   }
                   1334:   y[1] = (long)u; return y;
                   1335: }
                   1336:
                   1337: static GEN
                   1338: addsell(GEN e, GEN z1, GEN z2, GEN p)
                   1339: {
                   1340:   GEN p1,p2,x,x1,x2,y,y1,y2;
                   1341:   long av = avma;
                   1342:
                   1343:   if (!z1) return z2;
                   1344:   if (!z2) return z1;
                   1345:
                   1346:   x1 = (GEN)z1[1]; y1 = (GEN)z1[2];
                   1347:   x2 = (GEN)z2[1]; y2 = (GEN)z2[2];
                   1348:   p2 = subii(x2, x1);
                   1349:   if (p2 == gzero)
                   1350:   {
                   1351:     if (!signe(y1) || !egalii(y1,y2)) return NULL;
                   1352:     p2 = shifti(y1,1);
                   1353:     p1 = addii(e, mulii(x1,mulsi(3,x1)));
                   1354:     p1 = resii(p1, p);
                   1355:   }
                   1356:   else p1 = subii(y2,y1);
                   1357:   p1 = mulii(p1, mpinvmod(p2, p));
                   1358:   p1 = resii(p1, p);
                   1359:   x = subii(sqri(p1), addii(x1,x2)); x = modii(x,p);
                   1360:   y = negi(addii(y1, mulii(p1,subii(x,x1))));
                   1361:   avma = av; p1 = cgetg(3,t_VEC);
                   1362:   p1[1] = licopy(x);
                   1363:   p1[2] = lmodii(y, p); return p1;
                   1364: }
                   1365:
                   1366: /* z1 <-- z1 + z2 */
                   1367: static void
                   1368: addsell_part2(GEN e, GEN z1, GEN z2, GEN p, GEN p2inv)
                   1369: {
                   1370:   GEN p1,x,x1,x2,y,y1,y2;
                   1371:
                   1372:   x1 = (GEN)z1[1]; y1 = (GEN)z1[2];
                   1373:   x2 = (GEN)z2[1]; y2 = (GEN)z2[2];
                   1374:   if (x1 == x2)
                   1375:   {
                   1376:     p1 = addii(e, mulii(x1,mulsi(3,x1)));
                   1377:     p1 = resii(p1, p);
                   1378:   }
                   1379:   else p1 = subii(y2,y1);
                   1380:
                   1381:   p1 = mulii(p1, p2inv);
                   1382:   p1 = resii(p1, p);
                   1383:   x = subii(sqri(p1), addii(x1,x2)); x = modii(x,p);
                   1384:   y = negi(addii(y1, mulii(p1,subii(x,x1)))); y = modii(y,p);
                   1385:   affii(x, x1);
                   1386:   affii(y, y1);
                   1387: }
                   1388:
                   1389: static GEN
                   1390: powsell(GEN e, GEN z, GEN n, GEN p)
                   1391: {
                   1392:   GEN y;
                   1393:   long s=signe(n),i,j;
                   1394:   ulong m;
                   1395:
                   1396:   if (!s || !z) return NULL;
                   1397:   if (s < 0)
                   1398:   {
                   1399:     n = negi(n); y = cgetg(3,t_VEC);
                   1400:     y[2] = lnegi((GEN)z[2]);
                   1401:     y[1] = z[1]; z = y;
                   1402:   }
                   1403:   if (is_pm1(n)) return z;
                   1404:
                   1405:   y = NULL;
                   1406:   for (i=lgefint(n)-1; i>2; i--)
                   1407:     for (m=n[i],j=0; j<BITS_IN_LONG; j++,m>>=1)
                   1408:     {
                   1409:       if (m&1) y = addsell(e,y,z,p);
                   1410:       z = addsell(e,z,z,p);
                   1411:     }
                   1412:   for (m=n[2]; m>1; m>>=1)
                   1413:   {
                   1414:     if (m&1) y = addsell(e,y,z,p);
                   1415:     z = addsell(e,z,z,p);
                   1416:   }
                   1417:   return addsell(e,y,z,p);
                   1418: }
                   1419:
                   1420: /* make sure *x has lgefint >= k */
                   1421: static void
                   1422: _fix(GEN x, long k)
                   1423: {
                   1424:   GEN y = (GEN)*x;
                   1425:   if (lgefint(y) < k) { GEN p1 = cgeti(k); affii(y,p1); *x = (long)p1; }
                   1426: }
                   1427:
                   1428: /* low word of integer x */
                   1429: #define _low(x) (__x=(GEN)x, __x[lgefint(__x)-1])
                   1430:
                   1431: /* compute a_p using Shanks/Mestre + Montgomery's trick. Assume p > 20, say */
                   1432: GEN
                   1433: apell1(GEN e, GEN p)
                   1434: {
                   1435:   long *tx, *ty, *ti, av = avma, av2,pfinal,i,j,j2,s,flc,flcc,x,nb;
                   1436:   GEN p1,p2,p3,h,mfh,f,fh,fg,pordmin,u,v,p1p,p2p,acon,bcon,c4,c6,cp4,pts;
                   1437:   GEN __x;
                   1438:
                   1439:   if (DEBUGLEVEL) timer2();
                   1440:   p1 = gmodulsg(1,p);
                   1441:   c4 = gdivgs(gmul(p1,(GEN)e[10]), -48);
                   1442:   c6 = gdivgs(gmul(p1,(GEN)e[11]), -864);
                   1443:   pordmin = gceil(gmul2n(gsqrt(p,DEFAULTPREC),2));
                   1444:   p1p = addsi(1,p); p2p = shifti(p1p,1);
                   1445:   x=0; flcc=0; flc = kronecker((GEN)c6[2],p);
                   1446:   u=c6; acon=gzero; bcon=gun; h=p1p;
                   1447:   tx = ty = ti = NULL; /* gcc -Wall */
                   1448:   for(;;)
                   1449:   {
                   1450:     while (flc==flcc || !flc)
                   1451:     {
                   1452:       x++;
                   1453:       u = gadd(c6, gmulsg(x, gaddgs(c4,x*x)));
                   1454:       flc = kronecker((GEN)u[2],p);
                   1455:     }
                   1456:     flcc = flc;
                   1457:     f = cgetg(3,t_VEC);
                   1458:     f[1] = (long)lift_intern(gmulsg(x,u));
                   1459:     f[2] = (long)lift_intern(gsqr(u));
                   1460:     cp4 = lift_intern(gmul(c4, (GEN)f[2]));
                   1461:     fh = powsell(cp4,f,h,p);
                   1462:     s = itos(gceil(gsqrt(gdiv(pordmin,bcon),DEFAULTPREC))) >> 1;
                   1463:     nb = min(128, s >> 1);
                   1464:     /* look for h s.t f^h = 0 */
                   1465:     if (bcon == gun)
                   1466:     { /* first time: initialize */
                   1467:       tx = newbloc(s+1);
                   1468:       ty = newbloc(s+1);
                   1469:       ti = newbloc(s+1);
                   1470:     }
                   1471:     else f = powsell(cp4,f,bcon,p); /* F */
                   1472:     *tx = evaltyp(t_VECSMALL) | evallg(s+1);
                   1473:     if (!fh) goto FOUND;
                   1474:
                   1475:     p1 = gcopy(fh);
                   1476:     pts = new_chunk(nb+1);
                   1477:     j = lgefint(p);
                   1478:     for (i=1; i<=nb; i++)
                   1479:     { /* baby steps */
                   1480:       pts[i] = (long)p1; /* h.f + (i-1).F */
                   1481:       _fix(p1+1, j); tx[i] = _low((GEN)p1[1]);
                   1482:       _fix(p1+2, j); ty[i] = _low((GEN)p1[2]);
                   1483:       p1 = addsell(cp4,p1,f,p); /* h.f + i.F */
                   1484:       if (!p1) { h = addii(h, mulsi(i,bcon)); goto FOUND; }
                   1485:     }
                   1486:     mfh = dummycopy(fh);
                   1487:     mfh[2] = lnegi((GEN)mfh[2]);
                   1488:     fg = addsell(cp4,p1,mfh,p); /* nb.F */
                   1489:     if (!fg) { h = mulsi(nb,bcon); goto FOUND; }
                   1490:     u = cgetg(nb+1, t_VEC);
                   1491:     av2 = avma; /* more baby steps, nb points at a time */
                   1492:     while (i <= s)
                   1493:     {
                   1494:       long maxj;
                   1495:       for (j=1; j<=nb; j++) /* adding nb.F (part 1) */
                   1496:       {
                   1497:         p1 = (GEN)pts[j]; /* h.f + (i-nb-1+j-1).F */
                   1498:         u[j] = lsubii((GEN)fg[1], (GEN)p1[1]);
                   1499:         if (u[j] == zero) /* sum = 0 or doubling */
                   1500:         {
                   1501:           long k = i+j-2;
                   1502:           if (egalii((GEN)p1[2],(GEN)fg[2])) k -= 2*nb; /* fg = p1 */
                   1503:           h = addii(h, mulsi(k,bcon));
                   1504:           goto FOUND;
                   1505:         }
                   1506:       }
                   1507:       v = multi_invmod(u, p);
                   1508:       maxj = (i-1 + nb <= s)? nb: s % nb;
                   1509:       for (j=1; j<=maxj; j++,i++) /* adding nb.F (part 2) */
                   1510:       {
                   1511:         p1 = (GEN)pts[j];
                   1512:         addsell_part2(cp4,p1,fg,p, (GEN)v[j]);
                   1513:         tx[i] = _low((GEN)p1[1]);
                   1514:         ty[i] = _low((GEN)p1[2]);
                   1515:       }
                   1516:       avma = av2;
                   1517:     }
                   1518:     p1 = addsell(cp4,(GEN)pts[j-1],mfh,p); /* = f^(s-1) */
                   1519:     if (DEBUGLEVEL) msgtimer("[apell1] baby steps, s = %ld",s);
                   1520:
                   1521:     /* giant steps: fg = f^s */
                   1522:     fg = addsell(cp4,p1,f,p);
                   1523:     if (!fg) { h = addii(h, mulsi(s,bcon)); goto FOUND; }
                   1524:     pfinal = _low(p); av2 = avma;
                   1525:
                   1526:     p1 = gen_sort(tx, cmp_IND | cmp_C, NULL);
                   1527:     for (i=1; i<=s; i++) ti[i] = tx[p1[i]];
                   1528:     for (i=1; i<=s; i++) { tx[i] = ti[i]; ti[i] = ty[p1[i]]; }
                   1529:     for (i=1; i<=s; i++) { ty[i] = ti[i]; ti[i] = p1[i]; }
                   1530:     if (DEBUGLEVEL) msgtimer("[apell1] sorting");
                   1531:     avma = av2;
                   1532:
                   1533:     gaffect(fg, (GEN)pts[1]);
                   1534:     for (j=2; j<=nb; j++) /* pts = first nb multiples of fg */
                   1535:       gaffect(addsell(cp4,(GEN)pts[j-1],fg,p), (GEN)pts[j]);
                   1536:     /* replace fg by nb.fg since we do nb points at a time */
                   1537:     avma = av2;
                   1538:     fg = gcopy((GEN)pts[nb]);
                   1539:     av2 = avma;
                   1540:
                   1541:     for (i=1,j=1; ; i++)
                   1542:     {
                   1543:       GEN ftest = (GEN)pts[j];
                   1544:       ulong m, l = 1, r = s+1;
                   1545:       long k, k2;
                   1546:
                   1547:       avma = av2;
                   1548:       k = _low((GEN)ftest[1]);
                   1549:       while (l<r)
                   1550:       {
                   1551:         m = (l+r) >> 1;
                   1552:         if (tx[m] < k) l = m+1; else r = m;
                   1553:       }
                   1554:       if (r <= (ulong)s && tx[r] == k)
                   1555:       {
                   1556:         while (tx[r] == k && r) r--;
                   1557:         k2 = _low((GEN)ftest[2]);
                   1558:         for (r++; tx[r] == k && r <= (ulong)s; r++)
                   1559:           if (ty[r] == k2 || ty[r] == pfinal - k2)
                   1560:           { /* [h+j2] f == ± ftest (= [i.s] f)? */
                   1561:             if (DEBUGLEVEL) msgtimer("[apell1] giant steps, i = %ld",i);
                   1562:             j2 = ti[r] - 1;
                   1563:             p1 = addsell(cp4, powsell(cp4,f,stoi(j2),p),fh,p);
                   1564:             if (egalii((GEN)p1[1], (GEN)ftest[1]))
                   1565:             {
                   1566:               if (egalii((GEN)p1[2], (GEN)ftest[2])) i = -i;
                   1567:               h = addii(h, mulii(addis(mulss(s,i), j2), bcon));
                   1568:               goto FOUND;
                   1569:             }
                   1570:           }
                   1571:       }
                   1572:       if (++j > nb)
                   1573:       { /* compute next nb points */
                   1574:         long save = 0; /* gcc -Wall */
                   1575:         for (j=1; j<=nb; j++)
                   1576:         {
                   1577:           p1 = (GEN)pts[j];
                   1578:           u[j] = lsubii((GEN)fg[1], (GEN)p1[1]);
                   1579:           if (u[j] == zero) /* occurs once: i = j = nb, p1 == fg */
                   1580:           {
                   1581:             u[j] = lshifti((GEN)p1[2],1);
                   1582:             save = fg[1]; fg[1] = p1[1];
                   1583:           }
                   1584:         }
                   1585:         v = multi_invmod(u, p);
                   1586:         for (j=1; j<=nb; j++)
                   1587:           addsell_part2(cp4, (GEN)pts[j],fg,p, (GEN)v[j]);
                   1588:         if (i == nb) { fg[1] = save; }
                   1589:         j = 1;
                   1590:       }
                   1591:     }
                   1592:
                   1593: FOUND: /* success, found a point of exponent h */
                   1594:     p2 = decomp(h); p1=(GEN)p2[1]; p2=(GEN)p2[2];
                   1595:     for (i=1; i<lg(p1); i++)
                   1596:       for (j=itos((GEN)p2[i]); j; j--)
                   1597:       {
                   1598:         p3 = divii(h,(GEN)p1[i]);
                   1599:         if (powsell(cp4,f,p3,p)) break;
                   1600:        h = p3;
                   1601:       }
                   1602:     /* now h is the exact order */
                   1603:     if (bcon == gun) bcon = h;
                   1604:     else
                   1605:     {
                   1606:       p1 = chinois(gmodulcp(acon,bcon), gmodulsg(0,h));
                   1607:       acon = (GEN)p1[2];
                   1608:       bcon = (GEN)p1[1];
                   1609:     }
                   1610:
                   1611:     i = (cmpii(bcon, pordmin) < 0);
                   1612:     if (i) acon = centermod(subii(p2p,acon), bcon);
                   1613:     p1 = ground(gdiv(gsub(p1p,acon),bcon));
                   1614:     h = addii(acon, mulii(p1,bcon));
                   1615:     if (!i) break;
                   1616:   }
                   1617:   gunclone(tx);
                   1618:   gunclone(ty);
                   1619:   gunclone(ti);
                   1620:   p1 = (flc==1)? subii(p1p,h): subii(h,p1p);
                   1621:   return gerepileupto(av,p1);
                   1622: }
                   1623:
                   1624: typedef struct
                   1625: {
                   1626:   int isnull;
                   1627:   long x,y;
                   1628: } sellpt;
                   1629:
                   1630: /* set p1 <-- p1 + p2, safe with p1 = p2 */
                   1631: static void
                   1632: addsell1(long e, long p, sellpt *p1, sellpt *p2)
                   1633: {
                   1634:   long num, den, lambda;
                   1635:
                   1636:   if (p1->isnull) { *p1 = *p2; return; }
                   1637:   if (p2->isnull) return;
                   1638:   if (p1->x == p2->x)
                   1639:   {
                   1640:     if (! p1->y || p1->y != p2->y) { p1->isnull = 1; return; }
                   1641:     num = addssmod(e, mulssmod(3, mulssmod(p1->x, p1->x, p), p), p);
                   1642:     den = addssmod(p1->y, p1->y, p);
                   1643:   }
                   1644:   else
                   1645:   {
                   1646:     num = subssmod(p1->y, p2->y, p);
                   1647:     den = subssmod(p1->x, p2->x, p);
                   1648:   }
                   1649:   lambda = divssmod(num, den, p);
                   1650:   num = subssmod(mulssmod(lambda, lambda, p), addssmod(p1->x, p2->x, p), p);
                   1651:   p1->y = subssmod(mulssmod(lambda, subssmod(p2->x, num, p), p), p2->y, p);
                   1652:   p1->x = num; /* necessary in case p1 = p2: we need p2->x above */
                   1653: }
                   1654:
                   1655: static void
                   1656: powssell1(long e, long p, long n, sellpt *p1, sellpt *p2)
                   1657: {
                   1658:   sellpt p3 = *p1;
                   1659:
                   1660:   if (n < 0) { n = -n; if (p3.y) p3.y = p - p3.y; }
                   1661:   p2->isnull = 1;
                   1662:   for(;;)
                   1663:   {
                   1664:     if (n&1) addsell1(e, p, p2, &p3);
                   1665:     n>>=1; if (!n) return;
                   1666:     addsell1(e, p, &p3, &p3);
                   1667:   }
                   1668: }
                   1669:
                   1670: typedef struct
                   1671: {
                   1672:   long x,y,i;
                   1673: } multiple;
                   1674:
                   1675: static int
                   1676: compare_multiples(multiple *a, multiple *b)
                   1677: {
                   1678:   return a->x - b->x;
                   1679: }
                   1680:
                   1681: /* assume e has good reduction at p. Should use Montgomery. */
                   1682: static GEN
                   1683: apell0(GEN e, long p)
                   1684: {
                   1685:   GEN p1,p2;
                   1686:   sellpt f,fh,fg,ftest,f2;
                   1687:   long pordmin,u,p1p,p2p,acon,bcon,c4,c6,cp4;
                   1688:   long av,i,j,s,flc,flcc,x,q,h,p3,l,r,m;
                   1689:   multiple *table;
                   1690:
                   1691:   if (p < 99) return apell2_intern(e,(ulong)p);
                   1692:
                   1693:   av = avma; p1 = gmodulss(1,p);
                   1694:   c4 = itos((GEN)gdivgs(gmul(p1,(GEN)e[10]), -48)[2]);
                   1695:   c6 = itos((GEN)gdivgs(gmul(p1,(GEN)e[11]), -864)[2]);
                   1696:   pordmin = (long)(1 + 4*sqrt((float)p));
                   1697:   p1p = p+1; p2p = p1p << 1;
                   1698:   x=0; flcc=0; flc = kross(c6, p);
                   1699:   u=c6; acon=0; bcon=1; h=p1p;
                   1700:   table = NULL; /* gcc -Wall */
                   1701:   for(;;)
                   1702:   {
                   1703:     while (flc==flcc || !flc)
                   1704:     {
                   1705:       x++;
                   1706:       u = addssmod(c6, mulssmod(x, c4+mulssmod(x,x,p), p), p);
                   1707:       flc = kross(u,p);
                   1708:     }
                   1709:     flcc = flc;
                   1710:     f.isnull = 0;
                   1711:     f.x = mulssmod(x, u, p);
                   1712:     f.y = mulssmod(u, u, p);
                   1713:     cp4 = mulssmod(c4, f.y, p);
                   1714:     powssell1(cp4, p, h, &f, &fh);
                   1715:     s = (long) (sqrt(((float)pordmin)/bcon) / 2);
                   1716:     if (!s) s=1;
                   1717:     if (bcon==1)
                   1718:     {
                   1719:       table = (multiple *) gpmalloc((s+1)*sizeof(multiple));
                   1720:       f2 = f;
                   1721:     }
                   1722:     else powssell1(cp4, p, bcon, &f, &f2);
                   1723:     for (i=0; i < s; i++)
                   1724:     {
                   1725:       if (fh.isnull) { h += bcon*i; goto FOUND; }
                   1726:       table[i].x = fh.x;
                   1727:       table[i].y = fh.y;
                   1728:       table[i].i = i;
                   1729:       addsell1(cp4, p, &fh, &f2);
                   1730:     }
                   1731:     qsort(table,s,sizeof(multiple),(QSCOMP)compare_multiples);
                   1732:     powssell1(cp4, p, s, &f2, &fg); ftest = fg;
                   1733:     for (i=1; ; i++)
                   1734:     {
                   1735:       if (ftest.isnull) err(bugparier,"apell (f^(i*s) = 1)");
                   1736:       l=0; r=s;
                   1737:       while (l<r)
                   1738:       {
                   1739:        m = (l+r) >> 1;
                   1740:        if (table[m].x < ftest.x) l=m+1; else r=m;
                   1741:       }
                   1742:       if (r < s && table[r].x == ftest.x) break;
                   1743:       addsell1(cp4, p, &ftest, &fg);
                   1744:     }
                   1745:     h += table[r].i * bcon;
                   1746:     if (table[r].y == ftest.y) i = -i;
                   1747:     h += s * i * bcon;
                   1748:
                   1749: FOUND:
                   1750:     p2=decomp(stoi(h)); p1=(GEN)p2[1]; p2=(GEN)p2[2];
                   1751:     for (i=1; i < lg(p1); i++)
                   1752:       for (j = mael(p2,i,2); j; j--)
                   1753:       {
                   1754:        p3 = h / mael(p1,i,2);
                   1755:        powssell1(cp4, p, p3, &f, &fh);
                   1756:        if (!fh.isnull) break;
                   1757:        h = p3;
                   1758:       }
                   1759:     if (bcon == 1) bcon = h;
                   1760:     else
                   1761:     {
                   1762:       p1 = chinois(gmodulss(acon,bcon), gmodulss(0,h));
                   1763:       acon = itos((GEN)p1[2]);
                   1764:       if (is_bigint(p1[1])) { h = acon; break; }
                   1765:       bcon = itos((GEN)p1[1]);
                   1766:     }
                   1767:
                   1768:     i = (bcon < pordmin);
                   1769:     if (i)
                   1770:     {
                   1771:       acon = (p2p - acon) % bcon;
                   1772:       if ((acon << 1) > bcon) acon -= bcon;
                   1773:     }
                   1774:     q = ((ulong)(p2p + bcon - (acon << 1))) / (bcon << 1);
                   1775:     h = acon + q*bcon;
                   1776:     avma = av; if (!i) break;
                   1777:   }
                   1778:   free(table); return stoi((flc==1)? p1p-h: h-p1p);
                   1779: }
                   1780:
                   1781: GEN
                   1782: apell(GEN e, GEN p)
                   1783: {
                   1784:   checkell(e);
                   1785:   if (typ(p)!=t_INT || signe(p)<0) err(talker,"not a prime in apell");
                   1786:   if (gdivise((GEN)e[12],p)) /* e[12] may be an intmod */
                   1787:   {
                   1788:     long av = avma,s;
                   1789:     GEN p0 = egalii(p,gdeux)? stoi(8): p;
                   1790:     GEN c6 = gmul((GEN)e[11],gmodulsg(1,p0));
                   1791:     s = kronecker(lift_intern(c6),p); avma=av;
                   1792:     if (mod4(p) == 3) s = -s;
                   1793:     return stoi(s);
                   1794:   }
                   1795:   if (cmpis(p, 0x3fffffff) > 0) return apell1(e, p);
                   1796:   return apell0(e, itos(p));
                   1797: }
                   1798:
                   1799: /* TEMPC is the largest prime whose square is less than HIGHBIT */
                   1800: #ifndef LONG_IS_64BIT
                   1801: #  define TEMPC 46337
                   1802: #  define TEMPMAX 16777215UL
                   1803: #else
                   1804: #  define TEMPC 3037000493
                   1805: #  define TEMPMAX 4294967295UL
                   1806: #endif
                   1807:
                   1808: GEN
                   1809: anell(GEN e, long n)
                   1810: {
                   1811:   long tab[4]={0,1,1,-1}; /* p prime; (-1/p) = tab[p&3]. tab[0] is not used */
                   1812:   long p, i, m, av, tetpil;
                   1813:   GEN p1,p2,an;
                   1814:
                   1815:   checkell(e);
                   1816:   for (i=1; i<=5; i++)
                   1817:     if (typ(e[i]) != t_INT) err(typeer,"anell");
                   1818:   if (n <= 0) return cgetg(1,t_VEC);
                   1819:   if ((ulong)n>TEMPMAX)
                   1820:     err(impl,"anell for n>=2^24 (or 2^32 for 64 bit machines)");
                   1821:   an = cgetg(n+1,t_VEC); an[1] = un;
                   1822:   for (i=2; i <= n; i++) an[i] = 0;
                   1823:   for (p=2; p<=n; p++)
                   1824:     if (!an[p])
                   1825:     {
                   1826:       if (!smodis((GEN)e[12],p)) /* mauvaise reduction, p | e[12] */
                   1827:        switch (tab[p&3] * krogs((GEN)e[11],p)) /* renvoie (-c6/p) */
                   1828:        {
                   1829:          case -1:  /* non deployee */
                   1830:            for (m=p; m<=n; m+=p)
                   1831:              if (an[m/p]) an[m]=lneg((GEN)an[m/p]);
                   1832:            continue;
                   1833:          case 0:   /* additive */
                   1834:            for (m=p; m<=n; m+=p) an[m]=zero;
                   1835:            continue;
                   1836:          case 1:   /* deployee */
                   1837:            for (m=p; m<=n; m+=p)
                   1838:              if (an[m/p]) an[m]=lcopy((GEN)an[m/p]);
                   1839:        }
                   1840:       else /* bonne reduction */
                   1841:       {
                   1842:         GEN ap = apell0(e,p);
                   1843:
                   1844:        if (p < TEMPC)
                   1845:        {
                   1846:          ulong pk, oldpk = 1;
                   1847:          for (pk=p; pk <= (ulong)n; oldpk=pk, pk *= p)
                   1848:          {
                   1849:            if (pk == (ulong)p) an[pk] = (long) ap;
                   1850:            else
                   1851:            {
                   1852:              av = avma;
                   1853:              p1 = mulii(ap, (GEN)an[oldpk]);
                   1854:              p2 = mulsi(p, (GEN)an[oldpk/p]);
                   1855:              tetpil = avma;
                   1856:              an[pk] = lpile(av,tetpil,subii(p1,p2));
                   1857:            }
                   1858:            for (m = n/pk; m > 1; m--)
                   1859:              if (an[m] && m%p) an[m*pk] = lmulii((GEN)an[m], (GEN)an[pk]);
                   1860:          }
                   1861:        }
                   1862:        else
                   1863:        {
                   1864:          an[p] = (long) ap;
                   1865:          for (m = n/p; m > 1; m--)
                   1866:            if (an[m] && m%p) an[m*p] = lmulii((GEN)an[m], (GEN)an[p]);
                   1867:        }
                   1868:       }
                   1869:     }
                   1870:   return an;
                   1871: }
                   1872:
                   1873: GEN
                   1874: akell(GEN e, GEN n)
                   1875: {
                   1876:   long i,j,ex,av=avma;
                   1877:   GEN p1,p2,ap,u,v,w,y,pl;
                   1878:
                   1879:   checkell(e);
                   1880:   if (typ(n)!=t_INT) err(talker,"not an integer type in akell");
                   1881:   if (signe(n)<= 0) return gzero;
                   1882:   y=gun; if (gcmp1(n)) return y;
                   1883:   p2=auxdecomp(n,1); p1=(GEN)p2[1]; p2=(GEN)p2[2];
                   1884:   for (i=1; i<lg(p1); i++)
                   1885:   {
                   1886:     pl=(GEN)p1[i];
                   1887:     if (divise((GEN)e[12], pl)) /* mauvaise reduction */
                   1888:     {
                   1889:       j = (((mod4(pl)+1)&2)-1)*kronecker((GEN)e[11],pl);
                   1890:       if (j<0 && mpodd((GEN)p2[i])) y = negi(y);
                   1891:       if (!j) { avma=av; return gzero; }
                   1892:     }
                   1893:     else /* bonne reduction */
                   1894:     {
                   1895:       ap=apell(e,pl); ex=itos((GEN)p2[i]);
                   1896:       u=ap; v=gun;
                   1897:       for (j=2; j<=ex; j++)
                   1898:       {
                   1899:        w = subii(mulii(ap,u), mulii(pl,v));
                   1900:        v=u; u=w;
                   1901:       }
                   1902:       y = mulii(u,y);
                   1903:     }
                   1904:   }
                   1905:   return gerepileupto(av,y);
                   1906: }
                   1907:
                   1908: GEN
                   1909: hell(GEN e, GEN a, long prec)
                   1910: {
                   1911:   long av=avma,tetpil,n;
                   1912:   GEN p1,p2,y,z,q,pi2surw,pi2isurw,qn,ps;
                   1913:
                   1914:   checkbell(e);
                   1915:   pi2surw=gdiv(gmul2n(mppi(prec),1),(GEN)e[15]);
                   1916:   pi2isurw=cgetg(3,t_COMPLEX); pi2isurw[1]=zero; pi2isurw[2]=(long)pi2surw;
                   1917:   z=gmul(greal(zell(e,a,prec)),pi2surw);
                   1918:   q=greal(gexp(gmul((GEN)e[16],pi2isurw),prec));
                   1919:   y=gsin(z,prec); n=0; qn=gun; ps=gneg_i(q);
                   1920:   do
                   1921:   {
                   1922:     n++; p1=gsin(gmulsg(2*n+1,z),prec); qn=gmul(qn,ps);
                   1923:     ps=gmul(ps,q); p1=gmul(p1,qn); y=gadd(y,p1);
                   1924:   }
                   1925:   while (gexpo(qn) >= - bit_accuracy(prec));
                   1926:   p1=gmul(gsqr(gdiv(gmul2n(y,1), d_ellLHS(e,a))),pi2surw);
                   1927:   p2=gsqr(gsqr(gdiv(p1,gsqr(gsqr(denom((GEN)a[1]))))));
                   1928:   p1=gdiv(gmul(p2,q),(GEN)e[12]);
                   1929:   p1=gmul2n(glog(gabs(p1,prec),prec),-5);
                   1930:   tetpil=avma; return gerepile(av,tetpil,gneg(p1));
                   1931: }
                   1932:
                   1933: static GEN
                   1934: hells(GEN e, GEN x, long prec)
                   1935: {
                   1936:   GEN w,z,t,mu,e72,e82;
                   1937:   long n,lim;
                   1938:
                   1939:   t = gdiv(realun(prec),(GEN)x[1]);
                   1940:   mu = gmul2n(glog(numer((GEN)x[1]),prec),-1);
                   1941:   e72 = gmul2n((GEN)e[7],1);
                   1942:   e82 = gmul2n((GEN)e[8],1);
                   1943:   lim = 6 + (bit_accuracy(prec) >> 1);
                   1944:   for (n=0; n<lim; n++)
                   1945:   {
                   1946:     w = gmul(t,gaddsg(4,gmul(t,gadd((GEN)e[6],gmul(t,gadd(e72,gmul(t,(GEN)e[8])))))));
                   1947:     z = gsub(gun,gmul(gsqr(t),gadd((GEN)e[7],gmul(t,gadd(e82,gmul(t,(GEN)e[9]))))));
                   1948:     mu = gadd(mu,gmul2n(glog(z,prec), -((n<<1)+3)));
                   1949:     t = gdiv(w,z);
                   1950:   }
                   1951:   return mu;
                   1952: }
                   1953:
                   1954: GEN
                   1955: hell2(GEN e, GEN x, long prec)
                   1956: {
                   1957:   GEN ep,e3,ro,p1,p2,mu,d,xp;
                   1958:   long av=avma,tetpil,lx,lc,i,j,tx;
                   1959:
                   1960:   if (!oncurve(e,x)) err(heller1);
                   1961:   d=(GEN)e[12]; ro=(GEN)e[14]; e3=(gsigne(d) < 0)?(GEN)ro[1]:(GEN)ro[3];
                   1962:   p1=cgetg(5,t_VEC); p1[1]=un; p1[2]=laddgs(gfloor(e3),-1);
                   1963:   p1[3]=p1[4]=zero; ep=coordch(e,p1); xp=pointch(x,p1);
                   1964:   tx=typ(x[1]); lx=lg(x);
                   1965:   if (!is_matvec_t(tx))
                   1966:   {
                   1967:     if (lx<3) { avma=av; return gzero; }
                   1968:     tetpil=avma; return gerepile(av,tetpil,hells(ep,xp,prec));
                   1969:   }
                   1970:   tx=typ(x);
                   1971:   tetpil=avma; mu=cgetg(lx,tx);
                   1972:   if (tx != t_MAT)
                   1973:     for (i=1; i<lx; i++) mu[i]=(long)hells(ep,(GEN)xp[i],prec);
                   1974:   else
                   1975:   {
                   1976:     lc=lg(x[1]);
                   1977:     for (i=1; i<lx; i++)
                   1978:     {
                   1979:       p1=cgetg(lc,t_COL); mu[i]=(long)p1; p2=(GEN)xp[i];
                   1980:       for (j=1; j<lc; j++) p1[j]=(long)hells(ep,(GEN)p2[j],prec);
                   1981:     }
                   1982:   }
                   1983:   return gerepile(av,tetpil,mu);
                   1984: }
                   1985:
                   1986: GEN
                   1987: hell0(GEN e, GEN z, long prec)
                   1988: {
                   1989:   GEN a,b,s,x,u,v,u1,p1,p2,r;
                   1990:   long n,i, ex = 5-bit_accuracy(prec);
                   1991:
                   1992:   /* cf. zell mais ne marche pas. Comment corriger? K.B. */
                   1993:   x = new_coords(e,(GEN)z[1],&a,&b,prec);
                   1994:
                   1995:   u = gmul2n(gadd(a,b), -1);
                   1996:   v = gsqrt(gmul(a,b), prec); s = gun;
                   1997:   for(n=0; ; n++)
                   1998:   {
                   1999:     p1 = gmul2n(gsub(x, gsqr(v)), -1);
                   2000:     p2 = gsqr(u);
                   2001:     x = gadd(p1, gsqrt(gadd(gsqr(p1), gmul(x, p2)), prec));
                   2002:     p2 = gadd(x, p2);
                   2003:     for (i=1; i<=n; i++) p2 = gsqr(p2);
                   2004:     s = gmul(s, p2);
                   2005:     u1 = gmul2n(gadd(u,v), -1);
                   2006:     r = gsub(u,u1);
                   2007:     if (gcmp0(r) || gexpo(r) < ex) break;
                   2008:
                   2009:     v = gsqrt(gmul(u,v), prec);
                   2010:     u = u1;
                   2011:   }
                   2012:   return gmul2n(glog(gdiv(gsqr(p2), s), prec) ,-1);
                   2013: }
                   2014:
                   2015: /* On suppose que `e' est a coeffs entiers donnee par un modele minimal */
                   2016: static GEN
                   2017: ghell0(GEN e, GEN a, long flag, long prec)
                   2018: {
                   2019:   long av=avma,lx,i,n,n2,grandn,tx=typ(a);
                   2020:   GEN p,p1,p2,x,y,z,phi2,psi2,psi3,logdep;
                   2021:
                   2022:   checkbell(e); if (!is_matvec_t(tx)) err(elliper1);
                   2023:   lx = lg(a); if (lx==1) return cgetg(1,tx);
                   2024:   tx=typ(a[1]);
                   2025:   if (is_matvec_t(tx))
                   2026:   {
                   2027:     z=cgetg(lx,tx);
                   2028:     for (i=1; i<lx; i++) z[i]=(long)ghell0(e,(GEN)a[i],flag,prec);
                   2029:     return z;
                   2030:   }
                   2031:   if (lg(a)<3) return gzero;
                   2032:   if (!oncurve(e,a)) err(heller1);
                   2033:
                   2034:   psi2=numer(d_ellLHS(e,a));
                   2035:   if (!signe(psi2)) { avma=av; return gzero; }
                   2036:
                   2037:   x=(GEN)a[1]; y=(GEN)a[2];
                   2038:   p2=gadd(gmulsg(3,(GEN)e[7]),gmul(x,gadd((GEN)e[6],gmulsg(3,x))));
                   2039:   psi3=numer(gadd((GEN)e[9],gmul(x,gadd(gmulsg(3,(GEN)e[8]),gmul(x,p2)))));
                   2040:   if (!signe(psi3)) { avma=av; return gzero; }
                   2041:
                   2042:   p1 = gmul(x,gadd(shifti((GEN)e[2],1),gmulsg(3,x)));
                   2043:   phi2=numer(gsub(gadd((GEN)e[4],p1), gmul((GEN)e[1],y)));
                   2044:   p1=(GEN)factor(mppgcd(psi2,phi2))[1]; lx=lg(p1);
                   2045:   switch(flag)
                   2046:   {
                   2047:     case 0:  z = hell2(e,a,prec); break; /* Tate 4^n */
                   2048:     case 1:  z = hell(e,a,prec);  break; /* Silverman's trick */
                   2049:     default: z = hell0(e,a,prec); break; /* Mestre's trick */
                   2050:   }
                   2051:   for (i=1; i<lx; i++)
                   2052:   {
                   2053:     p=(GEN)p1[i];
                   2054:     if (signe(resii((GEN)e[10],p)))
                   2055:     {
                   2056:       grandn=ggval((GEN)e[12],p);
                   2057:       if (grandn)
                   2058:       {
                   2059:         n2=ggval(psi2,p); n=n2<<1;
                   2060:         logdep=gneg_i(glog(p,prec));
                   2061:        if (n>grandn) n=grandn;
                   2062:        p2=divrs(mulsr(n*(grandn+grandn-n),logdep),grandn<<3);
                   2063:        z=gadd(z,p2);
                   2064:       }
                   2065:     }
                   2066:     else
                   2067:     {
                   2068:       n2=ggval(psi2,p);
                   2069:       logdep=gneg_i(glog(p,prec));
                   2070:       n=ggval(psi3,p);
                   2071:       if (n>=3*n2) p2=gdivgs(mulsr(n2,logdep),3);
                   2072:       else p2=gmul2n(mulsr(n,logdep),-3);
                   2073:       z=gadd(z,p2);
                   2074:     }
                   2075:   }
                   2076:   return gerepileupto(av,z);
                   2077: }
                   2078:
                   2079: GEN
                   2080: ellheight0(GEN e, GEN a, long flag, long prec)
                   2081: {
                   2082:   switch(flag)
                   2083:   {
                   2084:     case 0: return ghell(e,a,prec);
                   2085:     case 1: return ghell2(e,a,prec);
                   2086:     case 2: return ghell0(e,a,2,prec);
                   2087:   }
                   2088:   err(flagerr,"ellheight");
                   2089:   return NULL; /* not reached */
                   2090: }
                   2091:
                   2092: GEN
                   2093: ghell2(GEN e, GEN a, long prec)
                   2094: {
                   2095:   return ghell0(e,a,0,prec);
                   2096: }
                   2097:
                   2098: GEN
                   2099: ghell(GEN e, GEN a, long prec)
                   2100: {
                   2101:   return ghell0(e,a,1,prec);
                   2102: }
                   2103:
                   2104: static long ellrootno_all(GEN e, GEN p, GEN* ptcond);
                   2105:
                   2106: GEN
                   2107: lseriesell(GEN e, GEN s, GEN A, long prec)
                   2108: {
                   2109:   long av=avma,av1,tetpil,lim,l,n,eps,flun;
                   2110:   GEN z,p1,p2,cg,cg1,v,cga,cgb,s2,ns,gs,N;
                   2111:
                   2112:   if (!A) A = gun;
                   2113:   else
                   2114:   {
                   2115:     if (gsigne(A)<=0)
                   2116:       err(talker,"cut-off point must be positive in lseriesell");
                   2117:     if (gcmpgs(A,1) < 0) A = ginv(A);
                   2118:   }
                   2119:   flun = gcmp1(A) && gcmp1(s);
                   2120:   eps = ellrootno_all(e,gun,&N);
                   2121:   if (flun && eps<0) { z=cgetr(prec); affsr(0,z); return z; }
                   2122:   cg1=mppi(prec); setexpo(cg1,2); cg=divrr(cg1,gsqrt(N,prec));
                   2123:   cga=gmul(cg,A); cgb=gdiv(cg,A);
                   2124:   l=(long)((pariC2*(prec-2) + fabs(gtodouble(s)-1.)*log(rtodbl(cga)))
                   2125:             / rtodbl(cgb)+1);
                   2126:   v = anell(e, min((ulong)l,TEMPMAX));
                   2127:   s2 = ns = NULL; /* gcc -Wall */
                   2128:   if (!flun) { s2=gsubsg(2,s); ns=gpui(cg,gsubgs(gmul2n(s,1),2),prec); }
                   2129:   z=gzero;
                   2130:   if (typ(s)==t_INT)
                   2131:   {
                   2132:     if (signe(s)<=0) { avma=av; return gzero; }
                   2133:     gs=mpfactr(itos(s)-1,prec);
                   2134:   }
                   2135:   else gs=ggamma(s,prec);
                   2136:   av1=avma; lim=stack_lim(av1,1);
                   2137:   for (n=1; n<=l; n++)
                   2138:   {
                   2139:     p1=gdiv(incgam4(s,gmulsg(n,cga),gs,prec),gpui(stoi(n),s,prec));
                   2140:     p2=flun? p1: gdiv(gmul(ns,incgam(s2,gmulsg(n,cgb),prec)),
                   2141:                       gpui(stoi(n),s2,prec));
                   2142:     if (eps<0) p2=gneg_i(p2);
                   2143:     z = gadd(z, gmul(gadd(p1,p2),
                   2144:                      ((ulong)n<=TEMPMAX)? (GEN)v[n]: akell(e,stoi(n))));
                   2145:     if (low_stack(lim, stack_lim(av1,1)))
                   2146:     {
                   2147:       if(DEBUGMEM>1) err(warnmem,"lseriesell");
                   2148:       z = gerepilecopy(av1,z);
                   2149:     }
                   2150:   }
                   2151:   tetpil=avma; return gerepile(av,tetpil,gdiv(z,gs));
                   2152: }
                   2153:
                   2154: /********************************************************************/
                   2155: /**                                                                **/
                   2156: /**                 Tate's algorithm e (cf Anvers IV)              **/
                   2157: /**               Kodaira types, global minimal model              **/
                   2158: /**                                                                **/
                   2159: /********************************************************************/
                   2160:
                   2161: /* Given an integral elliptic curve in ellinit form, and a prime p, returns the
                   2162:   type of the fiber at p of the Neron model, as well as the change of variables
                   2163:   in the form [f, kod, v, c].
                   2164:
                   2165:   * The integer f is the conductor's exponent.
                   2166:
                   2167:   * The integer kod is the Kodaira type using the following notation:
                   2168:     II , III , IV  -->  2, 3, 4
                   2169:     I0  -->  1
                   2170:     Inu --> 4+nu for nu > 0
                   2171:   A '*' negates the code (e.g I* --> -2)
                   2172:
                   2173:   * v is a quadruple [u, r, s, t] yielding a minimal model
                   2174:
                   2175:   * c is the Tamagawa number.
                   2176:
                   2177:   Uses Tate's algorithm (Anvers IV). Given the remarks at the bottom of
                   2178:   page 46, the "long" algorithm is used for p < 4 only. */
                   2179: static void cumule(GEN *vtotal, GEN *e, GEN u, GEN r, GEN s, GEN t);
                   2180: static void cumule1(GEN *vtotal, GEN *e, GEN v2);
                   2181:
                   2182: static GEN
                   2183: localreduction_result(long av, long f, long kod, long c, GEN v)
                   2184: {
                   2185:   long tetpil = avma;
                   2186:   GEN result = cgetg(5, t_VEC);
                   2187:   result[1] = lstoi(f); result[2] = lstoi(kod);
                   2188:   result[3] = lcopy(v); result[4] = lstoi(c);
                   2189:   return gerepile(av,tetpil, result);
                   2190: }
                   2191:
                   2192: /* ici, p != 2 et p != 3 */
                   2193: static GEN
                   2194: localreduction_carac_not23(GEN e, GEN p)
                   2195: {
                   2196:   long av = avma, k, f, kod, c, nuj, nudelta;
                   2197:   GEN pk, p2k, a2prime, a3prime;
                   2198:   GEN p2, r = gzero, s = gzero, t = gzero, v;
                   2199:   GEN c4, c6, delta, unmodp, xun, tri, var, p4k, p6k;
                   2200:
                   2201:   nudelta = ggval((GEN)e[12], p);
                   2202:   v = cgetg(5,t_VEC); v[1] = un; v[2] = v[3] = v[4] = zero;
                   2203:   nuj = gcmp0((GEN)e[13])? 0: - ggval((GEN)e[13], p);
                   2204:   k = (nuj > 0 ? nudelta - nuj : nudelta) / 12;
                   2205:   c4 = (GEN)e[10]; c6 = (GEN)e[11]; delta = (GEN)e[12];
                   2206:   if (k > 0) /* modele non minimal */
                   2207:   {
                   2208:     pk = gpuigs(p, k);
                   2209:     if (mpodd((GEN)e[1]))
                   2210:       s = shifti(subii(pk, (GEN)e[1]), -1);
                   2211:     else
                   2212:       s = negi(shifti((GEN)e[1], -1));
                   2213:     p2k = sqri(pk);
                   2214:     p4k = sqri(p2k);
                   2215:     p6k = mulii(p4k, p2k);
                   2216:
                   2217:     a2prime = subii((GEN)e[2], mulii(s, addii((GEN)e[1], s)));
                   2218:     switch(smodis(a2prime, 3))
                   2219:     {
                   2220:       case 0: r = negi(divis(a2prime, 3)); break;
                   2221:       case 1: r = divis(subii(p2k, a2prime), 3); break;
                   2222:       case 2: r = negi(divis(addii(a2prime, p2k), 3)); break;
                   2223:     }
                   2224:     a3prime = ellLHS0_i(e,r);
                   2225:     if (mpodd(a3prime))
                   2226:       t = shifti(subii(mulii(pk, p2k), a3prime), -1);
                   2227:     else
                   2228:       t = negi(shifti(a3prime, -1));
                   2229:     v[1] = (long)pk; v[2] = (long)r; v[3] = (long)s; v[4] = (long)t;
                   2230:     nudelta -= 12 * k;
                   2231:     c4 = divii(c4, p4k); c6 = divii(c6, p6k);
                   2232:     delta = divii(delta, sqri(p6k));
                   2233:   }
                   2234:   if (nuj > 0) switch(nudelta - nuj)
                   2235:   {
                   2236:     case 0: f = 1; kod = 4+nuj; /* Inu */
                   2237:       switch(kronecker(negi(c6),p))
                   2238:       {
                   2239:        case  1: c = nudelta; break;
                   2240:        case -1: c = odd(nudelta)? 1: 2; break;
                   2241:        default: err(bugparier,"localred (p | c6)");
                   2242:           return NULL; /* not reached */
                   2243:       }
                   2244:       break;
                   2245:     case 6: f = 2; kod = -4-nuj; /* Inu* */
                   2246:       if (nuj & 1)
                   2247:        c = 3 + kronecker(divii(mulii(c6, delta),gpuigs(p, 9+nuj)), p);
                   2248:       else
                   2249:        c = 3 + kronecker(divii(delta, gpuigs(p, 6+nuj)), p);
                   2250:       break;
                   2251:     default: err(bugparier,"localred (nu_delta - nu_j != 0,6)");
                   2252:       return NULL; /* not reached */
                   2253:   }
                   2254:   else switch(nudelta)
                   2255:   {
                   2256:     case  0: f = 0; kod = 1; c = 1; break; /* I0, regulier */
                   2257:     case  2: f = 2; kod = 2; c = 1; break; /* II   */
                   2258:     case  3: f = 2; kod = 3; c = 2; break; /* III  */
                   2259:     case  4: f = 2; kod = 4; /* IV   */
                   2260:       c = 2 + kronecker(gdiv(mulis(c6, -6), sqri(p)), p);
                   2261:       break;
                   2262:     case  6: f = 2; kod = -1; /* I0*  */
                   2263:       p2 = sqri(p);
                   2264:       unmodp = gmodulsg(1,p);
                   2265:       var = gmul(unmodp,polx[0]);
                   2266:       tri = gsub(gsqr(var),gmul(divii(gmulsg(3, c4), p2),unmodp));
                   2267:       tri = gsub(gmul(tri, var),
                   2268:                 gmul(divii(gmul2n(c6,1), mulii(p2,p)),unmodp));
                   2269:       xun = gmodulcp(var,tri);
                   2270:       c = lgef(ggcd((GEN)(gsub(gpui(xun,p,0),xun))[2], tri)) - 2;
                   2271:       break;
                   2272:     case  8: f = 2; kod = -4; /* IV*  */
                   2273:       c = 2 + kronecker(gdiv(mulis(c6,-6), gpuigs(p,4)), p);
                   2274:       break;
                   2275:     case  9: f = 2; kod = -3; c = 2; break; /* III* */
                   2276:     case 10: f = 2; kod = -2; c = 1; break; /* II*  */
                   2277:     default: err(bugparier,"localred");
                   2278:       return NULL; /* not reached */
                   2279:   }
                   2280:   return localreduction_result(av,f,kod,c,v);
                   2281: }
                   2282:
                   2283: /* renvoie a_{ k,l } avec les notations de Tate */
                   2284: static int
                   2285: aux(GEN ak, int p, int l)
                   2286: {
                   2287:   long av = avma, pl = p, res;
                   2288:   while (--l) pl *= p;
                   2289:   res = smodis(divis(ak, pl), p);
                   2290:   avma = av; return res;
                   2291: }
                   2292:
                   2293: static int
                   2294: aux2(GEN ak, int p, GEN pl)
                   2295: {
                   2296:   long av = avma, res;
                   2297:   res = smodis(divii(ak, pl), p);
                   2298:   avma = av;
                   2299:   return res;
                   2300: }
                   2301:
                   2302: /* renvoie le nombre de racines distinctes du polynome XXX + aXX + bX + c
                   2303:  * modulo p s'il y a une racine multiple, elle est renvoyee dans *mult
                   2304:  */
                   2305: static int
                   2306: numroots3(int a, int b, int c, int p, int *mult)
                   2307: {
                   2308:   if (p == 2)
                   2309:   {
                   2310:     if ((c + a * b) & 1) return 3;
                   2311:     else { *mult = b; return (a + b) & 1 ? 2 : 1; }
                   2312:   }
                   2313:   else
                   2314:   {
                   2315:     if (a % 3) { *mult = a * b; return (a * b * (1 - b) + c) % 3 ? 3 : 2; }
                   2316:     else { *mult = -c; return b % 3 ? 3 : 1; }
                   2317:   }
                   2318: }
                   2319:
                   2320: /* idem pour aXX +bX + c */
                   2321: static int
                   2322: numroots2(int a, int b, int c, int p, int *mult)
                   2323: {
                   2324:   if (p == 2) { *mult = c; return b & 1 ? 2 : 1; }
                   2325:   else { *mult = a * b; return (b * b - a * c) % 3 ? 2 : 1; }
                   2326: }
                   2327:
                   2328: /* ici, p1 = 2 ou p1 = 3 */
                   2329: static GEN
                   2330: localreduction_carac_23(GEN e, GEN p1)
                   2331: {
                   2332:   long av = avma, p, c, nu, nudelta;
                   2333:   int a21, a42, a63, a32, a64, theroot, al, be, ga;
                   2334:   GEN pk, p2k, pk1, p4, p6;
                   2335:   GEN p2, p3, r = gzero, s = gzero, t = gzero, v;
                   2336:
                   2337:   nudelta = ggval((GEN)e[12], p1);
                   2338:   v = cgetg(5,t_VEC); v[1] = un; v[2] = v[3] = v[4] = zero;
                   2339:
                   2340:   for(;;)
                   2341:   {
                   2342:     if (!nudelta)
                   2343:       return localreduction_result(av, 0, 1, 1, v);
                   2344:        /* I0   */
                   2345:     p = itos(p1);
                   2346:     if (!divise((GEN)e[6], p1))
                   2347:     {
                   2348:       if (smodis(negi((GEN)e[11]), p == 2 ? 8 : 3) == 1)
                   2349:        c = nudelta;
                   2350:       else
                   2351:        c = 2 - (nudelta & 1);
                   2352:       return localreduction_result(av, 1, 4 + nudelta, c, v);
                   2353:     }
                   2354:        /* Inu  */
                   2355:     if (p == 2)
                   2356:     {
                   2357:       r = modis((GEN)e[4], 2);
                   2358:       s = modis(addii(r, (GEN)e[2]), 2);
                   2359:       if (signe(r)) t = modis(addii(addii((GEN)e[4], (GEN)e[5]), s), 2);
                   2360:       else t = modis((GEN)e[5], 2);
                   2361:     }
                   2362:     else /* p == 3 */
                   2363:     {
                   2364:       r = negi(modis((GEN)e[8], 3));
                   2365:       s = modis((GEN)e[1], 3);
                   2366:       t = modis(ellLHS0_i(e,r), 3);
                   2367:     }
                   2368:     cumule(&v, &e, gun, r, s, t); /* p | a1, a2, a3, a4 et a6 */
                   2369:     p2 = stoi(p*p);
                   2370:     if (!divise((GEN)e[5], p2))
                   2371:       return localreduction_result(av, nudelta, 2, 1, v);
                   2372:        /* II   */
                   2373:     p3 = stoi(p*p*p);
                   2374:     if (!divise((GEN)e[9], p3))
                   2375:       return localreduction_result(av, nudelta - 1, 3, 2, v);
                   2376:        /* III  */
                   2377:     if (!divise((GEN)e[8], p3))
                   2378:     {
                   2379:       if (smodis((GEN)e[8], (p==2)? 32: 27) == p*p)
                   2380:        c = 3;
                   2381:       else
                   2382:        c = 1;
                   2383:       return localreduction_result(av, nudelta - 2, 4, c, v);
                   2384:     }
                   2385:        /* IV   */
                   2386:
                   2387:        /* now for the last five cases... */
                   2388:
                   2389:     if (!divise((GEN)e[5], p3))
                   2390:       cumule(&v, &e, gun, gzero, gzero, p == 2? gdeux: modis((GEN)e[3], 9));
                   2391:        /* p | a1, a2; p^2  | a3, a4; p^3 | a6 */
                   2392:     a21 = aux((GEN)e[2], p, 1); a42 = aux((GEN)e[4], p, 2);
                   2393:     a63 = aux((GEN)e[5], p, 3);
                   2394:     switch (numroots3(a21, a42, a63, p, &theroot))
                   2395:     {
                   2396:       case 3:
                   2397:        if (p == 2)
                   2398:          c = 1 + (a63 == 0) + ((a21 + a42 + a63) & 1);
                   2399:        else
                   2400:          c = 1 + (a63 == 0) + (((1 + a21 + a42 + a63) % 3) == 0)
                   2401:              + (((1 - a21 + a42 - a63) % 3) == 0);
                   2402:        return localreduction_result(av, nudelta - 4, -1, c, v);
                   2403:            /* I0*  */
                   2404:       case 2: /* calcul de nu */
                   2405:        if (theroot) cumule(&v, &e, gun, stoi(theroot * p), gzero, gzero);
                   2406:            /* p | a1; p^2  | a2, a3; p^3 | a4; p^4 | a6 */
                   2407:        nu = 1;
                   2408:        pk = p2;
                   2409:        p2k = stoi(p * p * p * p);
                   2410:        for(;;)
                   2411:        {
                   2412:          if (numroots2(al = 1, be = aux2((GEN)e[3], p, pk),
                   2413:                        ga = -aux2((GEN)e[5], p, p2k), p, &theroot) == 2)
                   2414:            break;
                   2415:          if (theroot) cumule(&v, &e, gun, gzero, gzero, mulsi(theroot,pk));
                   2416:          pk1 = pk; pk = mulsi(p, pk); p2k = mulsi(p, p2k);
                   2417:          nu++;
                   2418:          if (numroots2(al = a21, be = aux2((GEN)e[4], p, pk),
                   2419:                        ga = aux2((GEN)e[5], p, p2k), p, &theroot) == 2)
                   2420:            break;
                   2421:          if (theroot) cumule(&v, &e, gun, mulsi(theroot, pk1), gzero, gzero);
                   2422:          p2k = mulsi(p, p2k);
                   2423:          nu++;
                   2424:        }
                   2425:        if (p == 2)
                   2426:          c = 4 - 2 * (ga & 1);
                   2427:        else
                   2428:          c = 3 + kross(be * be - al * ga, 3);
                   2429:        return localreduction_result(av, nudelta - 4 - nu, -4 - nu, c, v);
                   2430:            /* Inu* */
                   2431:       case 1:
                   2432:        if (theroot) cumule(&v, &e, gun, stoi(theroot * p), gzero, gzero);
                   2433:            /* p | a1; p^2  | a2, a3; p^3 | a4; p^4 | a6 */
                   2434:        a32 = aux((GEN)e[3], p, 2); a64 = aux((GEN)e[5], p, 4);
                   2435:        if (numroots2(1, a32, -a64, p, &theroot) == 2)
                   2436:        {
                   2437:          if (p == 2)
                   2438:            c = 3 - 2 * a64;
                   2439:          else
                   2440:            c = 2 + kross(a32 * a32 + a64, 3);
                   2441:          return localreduction_result(av, nudelta - 6, -4, c, v);
                   2442:        }
                   2443:            /* IV*  */
                   2444:        if (theroot) cumule(&v, &e, gun, gzero, gzero, stoi(theroot*p*p));
                   2445:            /* p | a1; p^2 | a2; p^3 | a3, a4; p^5 | a6 */
                   2446:        p4 = sqri(p2);
                   2447:        if (!divise((GEN)e[4], p4))
                   2448:          return localreduction_result(av, nudelta - 7, -3, 2, v);
                   2449:            /* III* */
                   2450:        p6 = mulii(p4, p2);
                   2451:        if (!divise((GEN)e[5], p6))
                   2452:          return localreduction_result(av, nudelta - 8, -2, 1, v);
                   2453:            /* II*  */
                   2454:        cumule(&v, &e, p1, gzero, gzero, gzero); /* non minimal, on repart
                   2455:                                                     pour un tour */
                   2456:        nudelta -= 12;
                   2457:     }
                   2458:   }
                   2459:   /* Not reached */
                   2460: }
                   2461:
                   2462: GEN
                   2463: localreduction(GEN e, GEN p1)
                   2464: {
                   2465:   checkell(e);
                   2466:   if (typ(e[12]) != t_INT)
                   2467:     err(talker,"not an integral curve in localreduction");
                   2468:   if (gcmpgs(p1, 3) > 0)       /* p different de 2 ou 3 */
                   2469:     return localreduction_carac_not23(e,p1);
                   2470:   else
                   2471:     return localreduction_carac_23(e,p1);
                   2472: }
                   2473:
                   2474: #if 0
                   2475: /*  Calcul de toutes les fibres non elliptiques d'une courbe sur Z.
                   2476:  *  Etant donne une courbe elliptique sous forme longue e, dont les coefficients
                   2477:  *  sont entiers, renvoie une matrice dont les lignes sont de la forme
                   2478:  *  [p, fp, kodp, cp]. Il y a une ligne par diviseur premier du discriminant.
                   2479:  */
                   2480: GEN
                   2481: globaltatealgo(GEN e)
                   2482: {
                   2483:   long k, l,av;
                   2484:   GEN p1, p2, p3, p4, prims, result;
                   2485:
                   2486:   checkell(e);
                   2487:   prims = decomp((GEN)e[12]);
                   2488:   l = lg(p1 = (GEN)prims[1]);
                   2489:   p2 = (GEN)prims[2];
                   2490:   if ((long)prims == avma) cgiv(prims);
                   2491:   result = cgetg(5, t_MAT);
                   2492:   result[1] = (long)p1;
                   2493:   result[2] = (long)p2;
                   2494:   result[3] = (long)(p3 = cgetg(l, t_COL));
                   2495:   for (k = 1; k < l; k++) p3[k] = lgeti(3);
                   2496:   result[4] = (long)(p4 = cgetg(l, t_COL));
                   2497:   for (k = 1; k < l; k++) p4[k] = lgeti(3);
                   2498:   av = avma;
                   2499:   for (k = 1; k < l; k++)
                   2500:   {
                   2501:     GEN q = localreduction(e, (GEN)p1[k]);
                   2502:     affii((GEN)q[1],(GEN)p2[k]);
                   2503:     affii((GEN)q[2],(GEN)p3[k]);
                   2504:     affii((GEN)q[4],(GEN)p4[k]);
                   2505:     avma = av;
                   2506:   }
                   2507:   return result;
                   2508: }
                   2509: #endif
                   2510:
                   2511: /* Algorithme de reduction d'une courbe sur Q a sa forme standard.  Etant
                   2512:  * donne une courbe elliptique sous forme longue e, dont les coefficients
                   2513:  * sont rationnels, renvoie son [N, [u, r, s, t], c], ou N est le conducteur
                   2514:  * arithmetique de e, [u, r, s, t] est le changement de variables qui reduit
                   2515:  * e a sa forme minimale globale dans laquelle a1 et a3 valent 0 ou 1, et a2
                   2516:  * vaut -1, 0 ou 1 et tel que u est un rationnel positif. Enfin c est le
                   2517:  * produit des nombres de Tamagawa locaux cp.
                   2518:  */
                   2519: GEN
                   2520: globalreduction(GEN e1)
                   2521: {
                   2522:   long i, k, l, m, tetpil, av = avma;
                   2523:   GEN p1, c = gun, prims, result, N = gun, u = gun, r, s, t;
                   2524:   GEN v = cgetg(5, t_VEC), a = cgetg(7, t_VEC), e = cgetg(20, t_VEC);
                   2525:
                   2526:   checkell(e1);
                   2527:   for (i = 1; i < 5; i++) a[i] = e1[i]; a[5] = zero; a[6] = e1[5];
                   2528:   prims = decomp(denom(a));
                   2529:   p1 = (GEN)prims[1]; l = lg(p1);
                   2530:   for (k = 1; k < l; k++)
                   2531:   {
                   2532:     int n = 0;
                   2533:     for (i = 1; i < 7; i++)
                   2534:       if (!gcmp0((GEN)a[i]))
                   2535:       {
                   2536:        m = i * n + ggval((GEN)a[i], (GEN)p1[k]);
                   2537:        while (m < 0) { n++; m += i; }
                   2538:       }
                   2539:     u = gmul(u, gpuigs((GEN)p1[k], n));
                   2540:   }
                   2541:   v[1] = linv(u); v[2] = v[3] = v[4] = zero;
                   2542:   for (i = 1; i < 14; i++) e[i] = e1[i];
                   2543:   for (; i < 20; i++) e[i] = zero;
                   2544:   if (!gcmp1(u)) e = coordch(e, v);
                   2545:   prims = decomp((GEN)e[12]);
                   2546:   l = lg(p1 = (GEN)prims[1]);
                   2547:   for (k = (signe(e[12]) < 0) + 1; k < l; k++)
                   2548:   {
                   2549:     GEN q = localreduction(e, (GEN)p1[k]);
                   2550:     GEN v1 = (GEN)q[3];
                   2551:     N = mulii(N, gpui((GEN)p1[k],(GEN)q[1],0));
                   2552:     c = mulii(c, (GEN)q[4]);
                   2553:     if (!gcmp1((GEN)v1[1])) cumule1(&v, &e, v1);
                   2554:   }
                   2555:   s = gdiventgs((GEN)e[1], -2);
                   2556:   r = gdiventgs(gaddgs(gsub(gsub((GEN)e[2], gmul(s,(GEN)e[1])), gsqr(s)), 1), -3);
                   2557:   t = gdiventgs(ellLHS0(e,r), -2);
                   2558:   cumule(&v, &e, gun, r, s, t);
                   2559:   tetpil = avma;
                   2560:   result = cgetg(4, t_VEC); result[1] = lcopy(N); result[2] = lcopy(v);
                   2561:   result[3] = lcopy(c);
                   2562:   return gerepile(av, tetpil, result);
                   2563: }
                   2564:
                   2565: /* cumule les effets de plusieurs chgts de variable. On traite a part les cas
                   2566:  * particuliers frequents, tels que soit u = 1, soit r' = s' = t' = 0
                   2567:  */
                   2568: static void
                   2569: cumulev(GEN *vtotal, GEN u, GEN r, GEN s, GEN t)
                   2570: {
                   2571:   long av = avma, tetpil;
                   2572:   GEN temp, v = *vtotal, v3 = cgetg(5, t_VEC);
                   2573:   if (gcmp1((GEN)v[1]))
                   2574:   {
                   2575:     v3[1] = lcopy(u);
                   2576:     v3[2] = ladd((GEN)v[2], r);
                   2577:     v3[3] = ladd((GEN)v[3], s);
                   2578:     av = avma;
                   2579:     temp = gadd((GEN)v[4], gmul((GEN)v[3], r));
                   2580:     tetpil = avma;
                   2581:     v3[4] = lpile(av, tetpil, gadd(temp, t));
                   2582:   }
                   2583:   else if (gcmp0(r) && gcmp0(s) && gcmp0(t))
                   2584:   {
                   2585:     v3[1] = lmul((GEN)v[1], u);
                   2586:     v3[2] = lcopy((GEN)v[2]);
                   2587:     v3[3] = lcopy((GEN)v[3]);
                   2588:     v3[4] = lcopy((GEN)v[4]);
                   2589:   }
                   2590:   else /* cas general */
                   2591:   {
                   2592:     v3[1] = lmul((GEN)v[1], u);
                   2593:     temp = gsqr((GEN)v[1]);
                   2594:     v3[2] = ladd(gmul(temp, r), (GEN)v[2]);
                   2595:     v3[3] = ladd(gmul((GEN)v[1], s), (GEN)v[3]);
                   2596:     v3[4] = ladd((GEN)v[4], gmul(temp, gadd(gmul((GEN)v[1], t), gmul((GEN)v[3], r))));
                   2597:
                   2598:     v3 = gerepilecopy(av, v3);
                   2599:   }
                   2600:   *vtotal = v3;
                   2601: }
                   2602:
                   2603: static void
                   2604: cumule(GEN *vtotal, GEN *e, GEN u, GEN r, GEN s, GEN t)
                   2605: {
                   2606:   long av = avma, tetpil;
                   2607:   GEN v2 = cgetg(5, t_VEC);
                   2608:   v2[1] = (long)u; v2[2] = (long)r; v2[3] = (long)s; v2[4] = (long)t;
                   2609:   tetpil = avma;
                   2610:   *e = gerepile(av, tetpil, coordch(*e, v2));
                   2611:   cumulev(vtotal, u, r, s, t);
                   2612: }
                   2613:
                   2614: static void
                   2615: cumule1(GEN *vtotal, GEN *e, GEN v2)
                   2616: {
                   2617:   *e = coordch(*e, v2);
                   2618:   cumulev(vtotal, (GEN)v2[1], (GEN)v2[2], (GEN)v2[3], (GEN)v2[4]);
                   2619: }
                   2620:
                   2621: /********************************************************************/
                   2622: /**                                                                **/
                   2623: /**                   Parametrisation modulaire                    **/
                   2624: /**                                                                **/
                   2625: /********************************************************************/
                   2626:
                   2627: GEN
                   2628: taniyama(GEN e)
                   2629: {
                   2630:   GEN v,w,c,d,s1,s2,s3;
                   2631:   long n,m,av=avma,tetpil;
                   2632:
                   2633:   checkell(e); v = cgetg(precdl+3,t_SER);
                   2634:   v[1] = evalsigne(1) | evalvalp(-2) | evalvarn(0);
                   2635:   v[2] = un;
                   2636:   c=gtoser(anell(e,precdl+1),0); setvalp(c,1);
                   2637:   d=ginv(c); c=gsqr(d);
                   2638:   for (n=-3; n<=precdl-4; n++)
                   2639:   {
                   2640:     if (n!=2)
                   2641:     {
                   2642:       s3=n?gzero:(GEN)e[7];
                   2643:       if (n>-3) s3=gadd(s3,gmul((GEN)e[6],(GEN)v[n+4]));
                   2644:       s2=gzero;
                   2645:       for (m=-2; m<=n+1; m++)
                   2646:        s2 = gadd(s2,gmulsg(m*(n+m),gmul((GEN)v[m+4],(GEN)c[n-m+4])));
                   2647:       s2=gmul2n(s2,-1);
                   2648:       s1=gzero;
                   2649:       for (m=-1; m+m<=n; m++)
                   2650:       {
                   2651:        if (m+m==n)
                   2652:           s1=gadd(s1,gsqr((GEN)v[m+4]));
                   2653:        else
                   2654:           s1=gadd(s1,gmul2n(gmul((GEN)v[m+4],(GEN)v[n-m+4]),1));
                   2655:       }
                   2656:       v[n+6]=ldivgs(gsub(gadd(gmulsg(6,s1),s3),s2),(n+2)*(n+1)-12);
                   2657:     }
                   2658:     else
                   2659:     {
                   2660:       setlg(v,9); v[8]=(long)polx[MAXVARN];
                   2661:       w=deriv(v,0); setvalp(w,-2);
                   2662:       s1=gadd((GEN)e[8],gmul(v,gadd(gmul2n((GEN)e[7],1),gmul(v,gadd((GEN)e[6],gmul2n(v,2))))));
                   2663:       setlg(v,precdl+3);
                   2664:       s2=gsub(s1,gmul(c,gsqr(w)));
                   2665:       s2=gsubst((GEN)s2[2],MAXVARN,polx[0]);
                   2666:       v[n+6]=lneg(gdiv((GEN)s2[2],(GEN)s2[3]));
                   2667:     }
                   2668:   }
                   2669:   w=gsub(gmul(polx[0],gmul(d,deriv(v,0))), ellLHS0(e,v));
                   2670:   tetpil=avma; s1=cgetg(3,t_VEC); s1[1]=lcopy(v); s1[2]=lmul2n(w,-1);
                   2671:   return gerepile(av,tetpil,s1);
                   2672: }
                   2673:
                   2674: /********************************************************************/
                   2675: /**                                                                **/
                   2676: /**                       TORSION POINTS (over Q)                  **/
                   2677: /**                                                                **/
                   2678: /********************************************************************/
                   2679: /* assume e is defined over Q (use Mazur's theorem) */
                   2680: GEN
                   2681: orderell(GEN e, GEN p)
                   2682: {
                   2683:   GEN p1;
                   2684:   long av=avma,k;
                   2685:
                   2686:   checkell(e); checkpt(p);
                   2687:   k=typ(e[13]);
                   2688:   if (k!=t_INT && !is_frac_t(k))
                   2689:     err(impl,"orderell for nonrational elliptic curves");
                   2690:   p1=p; k=1;
                   2691:   for (k=1; k<16; k++)
                   2692:   {
                   2693:     if (lg(p1)<3) { avma=av; return stoi(k); }
                   2694:     p1 = addell(e,p1,p);
                   2695:   }
                   2696:   avma=av; return gzero;
                   2697: }
                   2698:
                   2699: /* one can do much better by factoring denom(D) (see ellglobalred) */
                   2700: static GEN
                   2701: ellintegralmodel(GEN e)
                   2702: {
                   2703:   GEN a = cgetg(6,t_VEC), v;
                   2704:   long i;
                   2705:
                   2706:   for (i=1; i<6; i++)
                   2707:   {
                   2708:     a[i]=e[i];
                   2709:     switch(typ(a[i]))
                   2710:     {
                   2711:       case t_INT: case t_FRAC: case t_FRACN: break;
                   2712:       default: err(talker, "not a rational curve in ellintegralmodel");
                   2713:     }
                   2714:   }
                   2715:   a = denom(a); if (gcmp1(a)) return NULL;
                   2716:   v = cgetg(5,t_VEC);
                   2717:   v[1]=linv(a); v[2]=v[3]=v[4]=zero; return v;
                   2718: }
                   2719:
                   2720: /* Using Lutz-Nagell */
                   2721:
                   2722: /* p is a polynomial of degree exactly 3 with integral coefficients
                   2723:  * and leading term 4. Outputs the vector of rational roots of p
                   2724:  */
                   2725: static GEN
                   2726: ratroot(GEN p)
                   2727: {
                   2728:   GEN v,a,ld;
                   2729:   long i,t;
                   2730:
                   2731:   i=2; while (!signe(p[i])) i++;
                   2732:   if (i==5)
                   2733:     { v=cgetg(2,t_VEC); v[1]=zero; return v; }
                   2734:   if (i==4)
                   2735:     { v=cgetg(3,t_VEC); v[1]=zero; v[2]=ldivgs((GEN)p[4],-4); return v; }
                   2736:
                   2737:   v=cgetg(4,t_VEC); t=1;
                   2738:   if (i==3) v[t++]=zero;
                   2739:   ld=divisors(gmul2n((GEN)p[i],2));
                   2740:   for (i=1; i<lg(ld); i++)
                   2741:   {
                   2742:     a = gmul2n((GEN)ld[i],-2);
                   2743:     if (!gsigne(poleval(p,a))) v[t++]=(long)a;
                   2744:     a = gneg_i(a);
                   2745:     if (!gsigne(poleval(p,a))) v[t++]=(long)a;
                   2746:   }
                   2747:   setlg(v,t); return v;
                   2748: }
                   2749:
                   2750: static int
                   2751: is_new_torsion(GEN e, GEN v, GEN p, long t2) {
                   2752:   GEN pk = p, pkprec = NULL;
                   2753:   long k,l;
                   2754:
                   2755:   for (k=2; k<=6; k++)
                   2756:   {
                   2757:     pk=addell(e,pk,p);
                   2758:     if (lg(pk)==2) return 1;
                   2759:
                   2760:     for (l=2; l<=t2; l++)
                   2761:       if (gegal((GEN)pk[1],gmael(v,l,1))) return 1;
                   2762:
                   2763:     if (pkprec && k<=5)
                   2764:       if (gegal((GEN)pk[1],(GEN)pkprec[1])) return 1;
                   2765:     pkprec=pk;
                   2766:   }
                   2767:   return 0;
                   2768: }
                   2769:
                   2770: GEN
                   2771: torsellnagelllutz(GEN e)
                   2772: {
                   2773:   GEN d,ld,pol,p1,lr,r,v,w,w2,w3;
                   2774:   long i,j,nlr,t,t2,k,k2,av=avma;
                   2775:
                   2776:   checkell(e);
                   2777:   v = ellintegralmodel(e);
                   2778:   if (v) e = coordch(e,v);
                   2779:   pol = RHSpol(e);
                   2780:   lr=ratroot(pol); nlr=lg(lr)-1;
                   2781:   r=cgetg(17,t_VEC); p1=cgetg(2,t_VEC); p1[1]=zero; r[1]=(long)p1;
                   2782:   for (t=1,i=1; i<=nlr; i++)
                   2783:   {
                   2784:     p1=cgetg(3,t_VEC);
                   2785:     p1[1] = lr[i];
                   2786:     p1[2] = lmul2n(gneg(ellLHS0(e,(GEN)lr[i])), -1);
                   2787:     r[++t]=(long)p1;
                   2788:   }
                   2789:   ld = factor(gmul2n(absi((GEN)e[12]), 4));
                   2790:   p1 = (GEN)ld[2]; k = lg(p1);
                   2791:   for (i=1; i<k; i++) p1[i] = lshifti((GEN)p1[i], -1);
                   2792:   ld = divisors(ld);
                   2793:   for (t2=t,j=1; j<lg(ld); j++)
                   2794:   {
                   2795:     d=(GEN)ld[j]; lr=ratroot(gsub(pol,gsqr(d)));
                   2796:     for (i=1; i<lg(lr); i++)
                   2797:     {
                   2798:       p1 = cgetg(3,t_VEC);
                   2799:       p1[1] = lr[i];
                   2800:       p1[2] = lmul2n(gsub(d,ellLHS0(e,(GEN)lr[i])), -1);
                   2801:
                   2802:       if (is_new_torsion(e,r,p1,t2))
                   2803:       {
                   2804:         GEN p2 = cgetg(3,t_VEC);
                   2805:         p2[1] = p1[1];
                   2806:         p2[2] = lsub((GEN)p1[2],d);
                   2807:        r[++t]=(long)p1;
                   2808:         r[++t]=(long)p2;
                   2809:       }
                   2810:     }
                   2811:   }
                   2812:   if (t==1)
                   2813:   {
                   2814:     avma=av; w=cgetg(4,t_VEC);
                   2815:     w[1] = un;
                   2816:     w[2] = lgetg(1,t_VEC);
                   2817:     w[3] = lgetg(1,t_VEC);
                   2818:     return w;
                   2819:   }
                   2820:
                   2821:   if (nlr<3)
                   2822:   {
                   2823:     w2=cgetg(2,t_VEC); w2[1]=lstoi(t);
                   2824:     for (k=2; k<=t; k++)
                   2825:       if (itos(orderell(e,(GEN)r[k])) == t) break;
                   2826:     if (k>t) err(bugparier,"torsell (bug1)");
                   2827:
                   2828:     w3=cgetg(2,t_VEC); w3[1]=r[k];
                   2829:   }
                   2830:   else
                   2831:   {
                   2832:     if (t&3) err(bugparier,"torsell (bug2)");
                   2833:     t2 = t>>1;
                   2834:     w2=cgetg(3,t_VEC); w2[1]=lstoi(t2); w2[2]=(long)gdeux;
                   2835:     for (k=2; k<=t; k++)
                   2836:       if (itos(orderell(e,(GEN)r[k])) == t2) break;
                   2837:     if (k>t) err(bugparier,"torsell (bug3)");
                   2838:
                   2839:     p1 = powell(e,(GEN)r[k],stoi(t>>2));
                   2840:     k2 = (lg(p1)==3 && gegal((GEN)r[2],p1))? 3: 2;
                   2841:     w3=cgetg(3,t_VEC); w3[1]=r[k]; w3[2]=r[k2];
                   2842:   }
                   2843:   if (v)
                   2844:   {
                   2845:     v[1] = linv((GEN)v[1]);
                   2846:     w3 = pointch(w3,v);
                   2847:   }
                   2848:   w=cgetg(4,t_VEC);
                   2849:   w[1] = lstoi(t);
                   2850:   w[2] = (long)w2;
                   2851:   w[3] = (long)w3;
                   2852:   return gerepilecopy(av, w);
                   2853: }
                   2854:
                   2855: /* Using Doud's algorithm */
                   2856:
                   2857: /* Input e and n, finds a bound for #Tor */
                   2858: static long
                   2859: torsbound(GEN e, long n)
                   2860: {
                   2861:   long av = avma, m, b, c, d, prime = 2;
                   2862:   byteptr p = diffptr;
                   2863:   GEN D = (GEN)e[12];
                   2864:
                   2865:   b = c = m = 0; p++;
                   2866:   while (m<n)
                   2867:   {
                   2868:     d = *p++; if (!d) err(primer1);
                   2869:     prime += d;
                   2870:     if (ggval(D,stoi(prime)) == 0)
                   2871:     {
                   2872:       b = cgcd(b, prime+1 - itos(apell0(e,prime)));
                   2873:       if (b==c) m++; else {c = b; m = 0;}
                   2874:       avma = av;
                   2875:     }
                   2876:   }
                   2877:   return b;
                   2878: }
                   2879:
                   2880: static GEN
                   2881: _round(GEN x, long *e)
                   2882: {
                   2883:   GEN y = grndtoi(x,e);
                   2884:   if (*e > -5 && bit_accuracy(gprecision(x)) < gexpo(y) - 10)
                   2885:     err(talker, "ellinit data not accurate enough. Increase precision");
                   2886:   return y;
                   2887: }
                   2888:
                   2889: /* Input the curve, a point, and an integer n, returns a point of order n
                   2890:    on the curve, or NULL if q is not rational. */
                   2891: static GEN
                   2892: torspnt(GEN E, GEN q, long n)
                   2893: {
                   2894:   GEN p = cgetg(3,t_VEC);
                   2895:   long e;
                   2896:   p[1] = lmul2n(_round(gmul2n((GEN)q[1],2), &e),-2);
                   2897:   if (e > -5) return NULL;
                   2898:   p[2] = lmul2n(_round(gmul2n((GEN)q[2],3), &e),-3);
                   2899:   if (e > -5) return NULL;
                   2900:   return (gcmp0(gimag(p)) && oncurve(E,p)
                   2901:       && lg(powell(E,p,stoi(n))) == 2
                   2902:       && itos(orderell(E,p)) == n)? greal(p): NULL;
                   2903: }
                   2904:
                   2905: static int
                   2906: smaller_x(GEN p, GEN q)
                   2907: {
                   2908:   int s = absi_cmp(denom(p), denom(q));
                   2909:   return (s<0 || (s==0 && absi_cmp(numer(p),numer(q)) < 0));
                   2910: }
                   2911:
                   2912: /* best generator in cycle of length k */
                   2913: static GEN
                   2914: best_in_cycle(GEN e, GEN p, long k)
                   2915: {
                   2916:   GEN p0 = p,q = p;
                   2917:   long i;
                   2918:
                   2919:   for (i=2; i+i<k; i++)
                   2920:   {
                   2921:     q = addell(e,q,p0);
                   2922:     if (cgcd(i,k)==1 && smaller_x((GEN)q[1], (GEN)p[1])) p = q;
                   2923:   }
                   2924:   return (gsigne(d_ellLHS(e,p)) < 0)? invell(e,p): p;
                   2925: }
                   2926:
                   2927: static GEN
                   2928: tors(GEN e, long k, GEN p, GEN q, GEN v)
                   2929: {
                   2930:   GEN p1,r;
                   2931:   if (q)
                   2932:   {
                   2933:     long n = k>>1;
                   2934:     GEN p1, best = q, np = powell(e,p,stoi(n));
                   2935:     if (n % 2 && smaller_x((GEN)np[1], (GEN)best[1])) best = np;
                   2936:     p1 = addell(e,q,np);
                   2937:     if (smaller_x((GEN)p1[1], (GEN)best[1])) q = p1;
                   2938:     else if (best == np) { p = addell(e,p,q); q = np; }
                   2939:     p = best_in_cycle(e,p,k);
                   2940:     if (v)
                   2941:     {
                   2942:       v[1] = linv((GEN)v[1]);
                   2943:       p = pointch(p,v);
                   2944:       q = pointch(q,v);
                   2945:     }
                   2946:     r = cgetg(4,t_VEC);
                   2947:     r[1] = lstoi(2*k); p1 = cgetg(3,t_VEC); p1[1] = lstoi(k); p1[2] = deux;
                   2948:     r[2] = (long)p1; p1 = cgetg(3,t_VEC); p1[1] = lcopy(p); p1[2] = lcopy(q);
                   2949:     r[3] = (long)p1;
                   2950:   }
                   2951:   else
                   2952:   {
                   2953:     if (p)
                   2954:     {
                   2955:       p = best_in_cycle(e,p,k);
                   2956:       if (v)
                   2957:       {
                   2958:         v[1] = linv((GEN)v[1]);
                   2959:         p = pointch(p,v);
                   2960:       }
                   2961:       r = cgetg(4,t_VEC);
                   2962:       r[1] = lstoi(k); p1 = cgetg(2,t_VEC); p1[1] = r[1];
                   2963:       r[2] = (long)p1; p1 = cgetg(2,t_VEC); p1[1] = lcopy(p);
                   2964:       r[3] = (long)p1;
                   2965:     }
                   2966:     else
                   2967:     {
                   2968:       r = cgetg(4,t_VEC);
                   2969:       r[1] = un;
                   2970:       r[2] = lgetg(1,t_VEC);
                   2971:       r[3] = lgetg(1,t_VEC);
                   2972:     }
                   2973:   }
                   2974:   return r;
                   2975: }
                   2976:
                   2977: GEN
                   2978: torselldoud(GEN e)
                   2979: {
                   2980:   long b,i,ord,av=avma,prec, k = 1;
                   2981:   GEN v,w1,w22,w1j,w12,p,tor1,tor2;
                   2982:
                   2983:   checkbell(e);
                   2984:   v = ellintegralmodel(e);
                   2985:   if (v) e = coordch(e,v);
                   2986:
                   2987:   b = lgefint((GEN)e[12]) >> 1; /* b = size of sqrt(D) */
                   2988:   prec = precision((GEN)e[15]);
                   2989:   if (prec < b) err(precer, "torselldoud");
                   2990:   b = max(b, DEFAULTPREC);
                   2991:   if (b < prec) { prec = b; e = gprec_w(e, b); }
                   2992:   b = torsbound(e,3);
                   2993:   if (b==1) { avma=av; return tors(e,1,NULL,NULL, v); }
                   2994:   w22 = gmul2n((GEN)e[16],-1);
                   2995:   w1 = (GEN)e[15];
                   2996:   if (b % 4)
                   2997:   {
                   2998:     p = NULL;
                   2999:     for (i=10; i>1; i--)
                   3000:     {
                   3001:       if (b%i != 0) continue;
                   3002:       w1j = gdivgs(w1,i);
                   3003:       p = torspnt(e,pointell(e,w1j,prec),i);
                   3004:       if (!p && i%2==0)
                   3005:       {
                   3006:         p = torspnt(e,pointell(e,gadd(w22,w1j),prec),i);
                   3007:         if (!p) p = torspnt(e,pointell(e,gadd(w22,gmul2n(w1j,1)),prec),i);
                   3008:       }
                   3009:       if (p) { k = i; break; }
                   3010:     }
                   3011:     return gerepileupto(av, tors(e,k,p,NULL, v));
                   3012:   }
                   3013:
                   3014:   ord = 0; tor1 = tor2 = NULL;
                   3015:   w12 = gmul2n((GEN)e[15],-1);
                   3016:   if ((p = torspnt(e,pointell(e,w12,prec),2)))
                   3017:   {
                   3018:     tor1 = p; ord++;
                   3019:   }
                   3020:   if ((p = torspnt(e,pointell(e,w22,prec),2))
                   3021:    || (!ord && (p = torspnt(e,pointell(e,gadd(w12,w22),prec),2))))
                   3022:   {
                   3023:     tor2 = p; ord += 2;
                   3024:   }
                   3025:
                   3026:   switch(ord)
                   3027:   {
                   3028:     case 0:
                   3029:       for (i=9; i>1; i-=2)
                   3030:       {
                   3031:         if (b%i!=0) continue;
                   3032:         w1j=gdivgs((GEN)e[15],i);
                   3033:         p = torspnt(e,pointell(e,w1j,prec),i);
                   3034:         if (p) { k = i; break; }
                   3035:       }
                   3036:       break;
                   3037:
                   3038:     case 1:
                   3039:       p = NULL;
                   3040:       for (i=12; i>2; i-=2)
                   3041:       {
                   3042:         if (b%i!=0) continue;
                   3043:         w1j=gdivgs((GEN)e[15],i);
                   3044:         p = torspnt(e,pointell(e,w1j,prec),i);
                   3045:         if (!p && i%4==0)
                   3046:           p = torspnt(e,pointell(e,gadd(w22,w1j),prec),i);
                   3047:         if (p) { k = i; break; }
                   3048:       }
                   3049:       if (!p) { p = tor1; k = 2; }
                   3050:       break;
                   3051:
                   3052:     case 2:
                   3053:       for (i=5; i>1; i-=2)
                   3054:       {
                   3055:         if (b%i!=0) continue;
                   3056:         w1j = gdivgs((GEN)e[15],i);
                   3057:         p = torspnt(e,pointell(e,gadd(w22,w1j),prec),i+i);
                   3058:         if (p) { k = 2*i; break; }
                   3059:       }
                   3060:       if (!p) { p = tor2; k = 2; }
                   3061:       tor2 = NULL; break;
                   3062:
                   3063:     case 3:
                   3064:       for (i=8; i>2; i-=2)
                   3065:       {
                   3066:         if (b%(2*i)!=0) continue;
                   3067:         w1j=gdivgs((GEN)e[15],i);
                   3068:         p = torspnt(e,pointell(e,w1j,prec),i);
                   3069:         if (p) { k = i; break; }
                   3070:       }
                   3071:       if (!p) { p = tor1; k = 2; }
                   3072:       break;
                   3073:   }
                   3074:   return gerepileupto(av, tors(e,k,p,tor2, v));
                   3075: }
                   3076:
                   3077: GEN
                   3078: elltors0(GEN e, long flag)
                   3079: {
                   3080:   switch(flag)
                   3081:   {
                   3082:     case 0: return torselldoud(e);
                   3083:     case 1: return torsellnagelllutz(e);
                   3084:     default: err(flagerr,"torsell");
                   3085:   }
                   3086:   return NULL; /* not reached */
                   3087: }
                   3088:
                   3089: /* par compatibilite */
                   3090: GEN torsell(GEN e) {return torselldoud(e);}
                   3091:
                   3092: /* LOCAL ROOT NUMBERS, D'APRES HALBERSTADT halberst@math.jussieu.fr */
                   3093:
                   3094: /* ici p=2 ou 3 */
                   3095: static long
                   3096: neron(GEN e, GEN p, long* ptkod)
                   3097: {
                   3098:   long av=avma,kod,v4,v6,vd;
                   3099:   GEN c4, c6, d, nv;
                   3100:
                   3101:   nv=localreduction(e,p);
                   3102:   kod=itos((GEN)nv[2]); *ptkod=kod;
                   3103:   c4=(GEN)e[10]; c6=(GEN)e[11]; d=(GEN)e[12];
                   3104:   v4=gcmp0(c4) ? 12 : ggval(c4,p);
                   3105:   v6=gcmp0(c6) ? 12 : ggval(c6,p);
                   3106:   vd=ggval(d,p);
                   3107:   avma=av;
                   3108:   switch(itos(p))
                   3109:   {
                   3110:     case 3:
                   3111:       if (labs(kod)>4) return 1;
                   3112:       else
                   3113:       {
                   3114:        switch(kod)
                   3115:        {
                   3116:          case -1: case 1: return v4&1 ? 2 : 1;
                   3117:          case -3: case 3: return (2*v6>vd+3) ? 2 : 1;
                   3118:          case -4: case 2:
                   3119:            switch (vd%6)
                   3120:            {
                   3121:              case 4: return 3;
                   3122:              case 5: return 4;
                   3123:              default: return v6%3==1 ? 2 : 1;
                   3124:            }
                   3125:          default: /* kod = -2 et 4 */
                   3126:            switch (vd%6)
                   3127:            {
                   3128:              case 0: return 2;
                   3129:              case 1: return 3;
                   3130:              default: return 1;
                   3131:            }
                   3132:        }
                   3133:       }
                   3134:     case 2:
                   3135:       if (kod>4) return 1;
                   3136:       else
                   3137:       {
                   3138:        switch(kod)
                   3139:         {
                   3140:          case 1: return (v6>0) ? 2 : 1;
                   3141:          case 2:
                   3142:            if (vd==4) return 1;
                   3143:            else
                   3144:            {
                   3145:              if (vd==7) return 3;
                   3146:              else return v4==4 ? 2 : 4;
                   3147:            }
                   3148:          case 3:
                   3149:            switch(vd)
                   3150:            {
                   3151:              case 6: return 3;
                   3152:              case 8: return 4;
                   3153:              case 9: return 5;
                   3154:              default: return v4==5 ? 2 : 1;
                   3155:            }
                   3156:          case 4: return v4>4 ? 2 : 1;
                   3157:          case -1:
                   3158:            switch(vd)
                   3159:            {
                   3160:              case 9: return 2;
                   3161:              case 10: return 4;
                   3162:              default: return v4>4 ? 3 : 1;
                   3163:            }
                   3164:          case -2:
                   3165:            switch(vd)
                   3166:            {
                   3167:              case 12: return 2;
                   3168:              case 14: return 3;
                   3169:              default: return 1;
                   3170:            }
                   3171:          case -3:
                   3172:            switch(vd)
                   3173:            {
                   3174:              case 12: return 2;
                   3175:              case 14: return 3;
                   3176:              case 15: return 4;
                   3177:              default: return 1;
                   3178:            }
                   3179:          case -4: return v6==7 ? 2 : 1;
                   3180:          case -5: return (v6==7 || v4==6) ? 2 : 1;
                   3181:          case -6:
                   3182:            switch(vd)
                   3183:            {
                   3184:              case 12: return 2;
                   3185:              case 13: return 3;
                   3186:              default: return v4==6 ? 2 : 1;
                   3187:            }
                   3188:          case -7: return (vd==12 || v4==6) ? 2 : 1;
                   3189:          default: return v4==6 ? 2 : 1;
                   3190:        }
                   3191:       }
                   3192:     default: return 0; /* should not occur */
                   3193:   }
                   3194: }
                   3195:
                   3196: static long
                   3197: ellrootno_2(GEN e)
                   3198: {
                   3199:   long n2,kod,u,v,x1,y1,d1,av=avma,v4,v6,w2;
                   3200:   GEN p=gdeux,c4,c6,tmp,p6;
                   3201:
                   3202:   n2=neron(e,p,&kod); c4=(GEN)e[10]; c6=(GEN)e[11]; p6=stoi(64);
                   3203:   if (gcmp0(c4)) {v4=12; u=0;}
                   3204:   else {v4=pvaluation(c4,p,&tmp); u=itos(modii(tmp,p6));}
                   3205:   if (gcmp0(c6)) {v6=12; v=0;}
                   3206:   else {v6=pvaluation(c6,p,&tmp); v=itos(modii(tmp,p6));}
                   3207:   (void)pvaluation((GEN)e[12],p,&tmp); d1=itos(modii(tmp,p6));
                   3208:   avma=av; x1=u+v+v;
                   3209:   if (kod>=5)
                   3210:     {w2=mpodd(addii((GEN)e[2],(GEN)e[3])) ? 1 : -1; avma=av; return w2;}
                   3211:   if (kod<-9) return (n2==2) ? -kross(-1,v) : -1;
                   3212:   switch(kod)
                   3213:   {
                   3214:     case 1: return 1;
                   3215:     case 2:
                   3216:       switch(n2)
                   3217:       {
                   3218:        case 1:
                   3219:          switch(v4)
                   3220:          {
                   3221:            case 4: return kross(-1,u);
                   3222:            case 5: return 1;
                   3223:            default: return -1;
                   3224:          }
                   3225:        case 2: return (v6==7) ? 1 : -1;
                   3226:        case 3: return (v%8==5 || (u*v)%8==5) ? 1 : -1;
                   3227:        case 4: if (v4>5) return kross(-1,v);
                   3228:          return (v4==5) ? -kross(-1,u) : -1;
                   3229:       }
                   3230:     case 3:
                   3231:       switch(n2)
                   3232:       {
                   3233:        case 1: return -kross(2,u*v);
                   3234:        case 2: return -kross(2,v);
                   3235:        case 3: y1=itos(modis(gsubsg(u,gmul2n(c6,-5)),16)); avma=av;
                   3236:          return (y1==7 || y1==11) ? 1 : -1;
                   3237:        case 4: return (v%8==3 || (2*u+v)%8==7) ? 1 : -1;
                   3238:        case 5: return v6==8 ? kross(2,x1) : kross(-2,u);
                   3239:       }
                   3240:     case -1:
                   3241:       switch(n2)
                   3242:       {
                   3243:        case 1: return -kross(2,x1);
                   3244:        case 2: return (v%8==7) || (x1%32==11) ? 1 : -1;
                   3245:        case 3: return v4==6 ? 1 : -1;
                   3246:        case 4: if (v4>6) return kross(-1,v);
                   3247:          return v4==6 ? -kross(-1,u*v) : -1;
                   3248:       }
                   3249:     case -2: return n2==1 ? kross(-2,v) : kross(-1,v);
                   3250:     case -3:
                   3251:       switch(n2)
                   3252:       {
                   3253:        case 1: y1=(u-2*v)%64; if (y1<0) y1+=64;
                   3254:          return (y1==3) || (y1==19) ? 1 : -1;
                   3255:        case 2: return kross(2*kross(-1,u),v);
                   3256:        case 3: return -kross(-1,u)*kross(-2*kross(-1,u),u*v);
                   3257:        case 4: return v6==11 ? kross(-2,x1) : -kross(-2,u);
                   3258:       }
                   3259:     case -5:
                   3260:       if (n2==1) return x1%32==23 ? 1 : -1;
                   3261:       else return -kross(2,2*u+v);
                   3262:     case -6:
                   3263:       switch(n2)
                   3264:       {
                   3265:        case 1: return 1;
                   3266:        case 2: return v6==10 ? 1 : -1;
                   3267:        case 3: return (u%16==11) || ((u+4*v)%16==3) ? 1 : -1;
                   3268:       }
                   3269:     case -7:
                   3270:       if (n2==1) return 1;
                   3271:       else
                   3272:       {
                   3273:        y1=itos(modis(gaddsg(u,gmul2n(c6,-8)),16)); avma=av;
                   3274:        if (v6==10) return (y1==9) || (y1==13) ? 1 : -1;
                   3275:        else return (y1==9) || (y1==5) ? 1 : -1;
                   3276:       }
                   3277:     case -8: return n2==2 ? kross(-1,v*d1) : -1;
                   3278:     case -9: return n2==2 ? -kross(-1,d1) : -1;
                   3279:     default: return -1;
                   3280:   }
                   3281: }
                   3282:
                   3283: static long
                   3284: ellrootno_3(GEN e)
                   3285: {
                   3286:   long n2,kod,u,v,d1,av=avma,r6,K4,K6,v4;
                   3287:   GEN p=stoi(3),c4,c6,tmp,p4;
                   3288:
                   3289:   n2=neron(e,p,&kod); c4=(GEN)e[10]; c6=(GEN)e[11]; p4=stoi(81);
                   3290:   if (gcmp0(c4)) { v4=12; u=0; }
                   3291:   else { v4=pvaluation(c4,p,&tmp); u=itos(modii(tmp,p4)); }
                   3292:   if (gcmp0(c6)) v=0;
                   3293:   else {(void)pvaluation(c6,p,&tmp); v=itos(modii(tmp,p4));}
                   3294:   (void)pvaluation((GEN)e[12],p,&tmp); d1=itos(modii(tmp,p4));
                   3295:   avma=av;
                   3296:   r6=v%9; K4=kross(u,3); K6=kross(v,3);
                   3297:   if (kod>4) return K6;
                   3298:   switch(kod)
                   3299:   {
                   3300:     case 1: case 3: case -3: return 1;
                   3301:     case 2:
                   3302:       switch(n2)
                   3303:       {
                   3304:        case 1: return (r6==4 || r6>6) ? 1 : -1;
                   3305:        case 2: return -K4*K6;
                   3306:        case 3: return 1;
                   3307:        case 4: return -K6;
                   3308:       }
                   3309:     case 4:
                   3310:       switch(n2)
                   3311:       {
                   3312:        case 1: return K6*kross(d1,3);
                   3313:        case 2: return -K4;
                   3314:        case 3: return -K6;
                   3315:       }
                   3316:     case -2: return n2==2 ? 1 : K6;
                   3317:     case -4:
                   3318:       switch(n2)
                   3319:       {
                   3320:        case 1:
                   3321:          if (v4==4) return (r6==4 || r6==8) ? 1 : -1;
                   3322:          else return (r6==1 || r6==2) ? 1 : -1;
                   3323:        case 2: return -K6;
                   3324:        case 3: return (r6==2 || r6==7) ? 1 : -1;
                   3325:        case 4: return K6;
                   3326:       }
                   3327:     default: return -1;
                   3328:   }
                   3329: }
                   3330:
                   3331: static long
                   3332: ellrootno_not23(GEN e, GEN p, GEN ex)
                   3333: {
                   3334:   GEN j;
                   3335:   long ep,z;
                   3336:
                   3337:   if (gcmp1(ex)) return -kronecker(negi((GEN)e[11]),p);
                   3338:   j=(GEN)e[13];
                   3339:   if (!gcmp0(j) && ggval(j,p) < 0) return kronecker(negi(gun),p);
                   3340:   ep=12/cgcd(12,ggval((GEN)e[12],p));
                   3341:   if (ep==4) z=2;
                   3342:   else z=(ep%2==0) ? 1 : 3;
                   3343:   return kronecker(stoi(-z),p);
                   3344: }
                   3345:
                   3346: static long
                   3347: ellrootno_intern(GEN e, GEN p, GEN ex)
                   3348: {
                   3349:   if (cmpis(p,3) > 0) return ellrootno_not23(e,p,ex);
                   3350:   switch(itos(p))
                   3351:   {
                   3352:     case 3: return ellrootno_3(e);
                   3353:     case 2: return ellrootno_2(e);
                   3354:     default: err(talker,"incorrect prime in ellrootno_intern");
                   3355:   }
                   3356:   return 0; /* not reached */
                   3357: }
                   3358:
                   3359: /* local epsilon factor at p, including p=0 for the infinite place. Global
                   3360:    if p==1. The equation can be non minimal, but must be over Q. Internal,
                   3361:    no garbage collection. */
                   3362: static long
                   3363: ellrootno_all(GEN e, GEN p, GEN* ptcond)
                   3364: {
                   3365:   long s,exs,i;
                   3366:   GEN fa,gr,cond,pr,ex;
                   3367:
                   3368:   gr=globalreduction(e);
                   3369:   e=coordch(e,(GEN)gr[2]);
                   3370:   cond=(GEN)gr[1]; if(ptcond) *ptcond=cond;
                   3371:   if (typ(e[12]) != t_INT)
                   3372:     err(talker,"not an integral curve in ellrootno");
                   3373:   if (typ(p) != t_INT || signe(p)<0)
                   3374:     err(talker,"not a nonnegative integer second arg in ellrootno");
                   3375:   exs = 0; /* gcc -Wall */
                   3376:   if (cmpis(p,2)>=0)
                   3377:   {
                   3378:     exs=ggval(cond,p);
                   3379:     if (!exs) return 1;
                   3380:   }
                   3381:   if (cmpis(p,3)>0) return ellrootno_not23(e,p,stoi(exs));
                   3382:   switch(itos(p))
                   3383:   {
                   3384:     case 3: return ellrootno_3(e);
                   3385:     case 2: return ellrootno_2(e);
                   3386:     case 1: s=-1; fa=factor(cond); pr=(GEN)fa[1]; ex=(GEN)fa[2];
                   3387:       for (i=1; i<lg(pr); i++) s*=ellrootno_intern(e,(GEN)pr[i],(GEN)ex[i]);
                   3388:       return s;
                   3389:     default: return -1; /* case 0: local factor at infinity = -1 */
                   3390:   }
                   3391: }
                   3392:
                   3393: long
                   3394: ellrootno(GEN e, GEN p)
                   3395: {
                   3396:   long av=avma,s;
                   3397:   if (!p) p = gun;
                   3398:   s=ellrootno_all(e, p, NULL);
                   3399:   avma=av; return s;
                   3400: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>