bridge/class-master/depend/pari/src/basemath/mftrace.c
/* mf a true mf or an fs2 */
mf a true mf or an fs2
mf a true mf or an fs2
static GEN
fs2_init(GEN mf, GEN F, long bit)
{
  pari_sp av = avma;
  long i, l, lim, N, k, k2, prec = nbits2prec(bit);
  GEN DEN, cusps, tab, gk, gkm1, W0, vW, vVW, vVF, vP, al0;
  GEN vE = mfgetembed(F, prec), pi4 = Pi2n(2, prec);
  if (lg(mf) == 7)
  {
    vW = NULL; 
    DEN = cusps = NULL; 
  }
  else
  { 
    vW = (fs2_get_bitprec(mf) < bit)? NULL: fs2_get_W(mf);
    cusps = fs2_get_cusps(mf);
    DEN = fs2_get_den(mf);
    mf = fs2_get_MF(mf);
  }
  N = MF_get_N(mf);
  gk = MF_get_gk(mf); gkm1 = gsubgs(gk, 1);
  k2 = itos(gmul2n(gk,1));
  k = k2 >> 1;
  vP = get_vP(k);
  if (vW)
  {
    tab = gel(vW,1); 
    lim = (lg(tab)-1) / N;
  }
  else
  { 
    double kd = gtodouble(gk), B = (bit + 10)*M_LN2;
    double L = (B + kd*log(B) + kd*kd*log(B)/B) / (4*M_PI);
    long n, Lw;
    lim = ((long)ceil(L*L));
    Lw = N*lim;
    tab = cgetg(Lw+1,t_VEC);
    for (n = 1; n <= Lw; n++)
    {
      pari_sp av = avma;
      gel(tab,n) = gerepileupto(av, WfromZ(sstoQ(n,N),vP, gkm1, k2, pi4, prec));
    }
    cusps = mfcusps_i(N);
    DEN = gmul2n(gmulgs(gpow(Pi2n(3, prec), gkm1, prec), mfindex(N)), -2);
    if (odd(k2)) DEN = gdiv(DEN, sqrtr_abs(Pi2n(-1,prec)));
  }
  l = lg(cusps);
  vVF = cgetg(l, t_VEC);
  vVW = cgetg(l, t_VEC);
  al0 = cgetg(l, t_VECSMALL);
  W0 = k2==1? ginv(pi4): gen_0;
  for (i = 1; i < l; i++)
  {
    long A, C, w, wi, Lw, n;
    GEN VF, W, paramsf, al;
    (void)cusp_AC(gel(cusps,i), &A,&C);
    wi = ugcd(N, C*C); w = N / wi; Lw = w*lim;
    VF = mfslashexpansion(mf, F, cusp2mat(A,C), Lw, 0, &paramsf, prec);
    av = avma; al = gel(paramsf, 1); if (gequal0(al)) al = NULL;
    for (n = 0; n <= Lw; n++)
    {
      GEN a = gel(VF,n+1);
      gel(VF,n+1) = gequal0(a)? gen_0: Rg_embedall(a, vE);
    }
    if (vW)
      W = gel(vW, i);
    else
    {
      W = cgetg(Lw+2, t_VEC);
      for (n = 0; n <= Lw; n++)
      {
        GEN c;
        if (!al) c = n? gel(tab, n * wi): W0;
        else
        {
          pari_sp av = avma;
          c = gerepileupto(av, WfromZ(gadd(al,sstoQ(n,w)),vP,gkm1,k2,pi4, prec));
        }
        gel(W,n+1) = c;
      }
    }
    al0[i] = !al;
    gel(vVF, i) = VF;
    gel(vVW, i) = W;
  }
  if (k2 <= 1) al0 = zero_zv(l-1); 
  return gerepilecopy(av, mkvecn(7, mf,vVW,cusps,vVF,utoipos(bit),al0,DEN));
}
static GEN fs2_init ( GEN mf , GEN F , long bit ) { pari_sp av = avma ; long i , l , lim , N , k , k2 , prec = nbits2prec ( bit ) ; GEN DEN , cusps , tab , gk , gkm1 , W0 , vW , vVW , vVF , vP , al0 ; GEN vE = mfgetembed ( F , prec ) , pi4 = Pi2n ( 2 , prec ) ; if ( lg ( mf ) == 7 ) { vW = NULL ; DEN = cusps = NULL ; } else { vW = ( fs2_get_bitprec ( mf ) < bit ) ? NULL : fs2_get_W ( mf ) ; cusps = fs2_get_cusps ( mf ) ; DEN = fs2_get_den ( mf ) ; mf = fs2_get_MF ( mf ) ; } N = MF_get_N ( mf ) ; gk = MF_get_gk ( mf ) ; gkm1 = gsubgs ( gk , 1 ) ; k2 = itos ( gmul2n ( gk , 1 ) ) ; k = k2 >> 1 ; vP = get_vP ( k ) ; if ( vW ) { tab = gel ( vW , 1 ) ; lim = ( lg ( tab ) - 1 ) / N ; } else { double kd = gtodouble ( gk ) , B = ( bit + 10 ) * M_LN2 ; double L = ( B + kd * log ( B ) + kd * kd * log ( B ) / B ) / ( 4 * M_PI ) ; long n , Lw ; lim = ( ( long ) ceil ( L * L ) ) ; Lw = N * lim ; tab = cgetg ( Lw + 1 , t_VEC ) ; for ( n = 1 ; n <= Lw ; n ++ ) { pari_sp av = avma ; gel ( tab , n ) = gerepileupto ( av , WfromZ ( sstoQ ( n , N ) , vP , gkm1 , k2 , pi4 , prec ) ) ; } cusps = mfcusps_i ( N ) ; DEN = gmul2n ( gmulgs ( gpow ( Pi2n ( 3 , prec ) , gkm1 , prec ) , mfindex ( N ) ) , -2 ) ; if ( odd ( k2 ) ) DEN = gdiv ( DEN , sqrtr_abs ( Pi2n ( -1 , prec ) ) ) ; } l = lg ( cusps ) ; vVF = cgetg ( l , t_VEC ) ; vVW = cgetg ( l , t_VEC ) ; al0 = cgetg ( l , t_VECSMALL ) ; W0 = k2 == 1 ? ginv ( pi4 ) : gen_0 ; for ( i = 1 ; i < l ; i ++ ) { long A , C , w , wi , Lw , n ; GEN VF , W , paramsf , al ; ( void ) cusp_AC ( gel ( cusps , i ) , & A , & C ) ; wi = ugcd ( N , C * C ) ; w = N / wi ; Lw = w * lim ; VF = mfslashexpansion ( mf , F , cusp2mat ( A , C ) , Lw , 0 , & paramsf , prec ) ; av = avma ; al = gel ( paramsf , 1 ) ; if ( gequal0 ( al ) ) al = NULL ; for ( n = 0 ; n <= Lw ; n ++ ) { GEN a = gel ( VF , n + 1 ) ; gel ( VF , n + 1 ) = gequal0 ( a ) ? gen_0 : Rg_embedall ( a , vE ) ; } if ( vW ) W = gel ( vW , i ) ; else { W = cgetg ( Lw + 2 , t_VEC ) ; for ( n = 0 ; n <= Lw ; n ++ ) { GEN c ; if ( ! al ) c = n ? gel ( tab , n * wi ) : W0 ; else { pari_sp av = avma ; c = gerepileupto ( av , WfromZ ( gadd ( al , sstoQ ( n , w ) ) , vP , gkm1 , k2 , pi4 , prec ) ) ; } gel ( W , n + 1 ) = c ; } } al0 [ i ] = ! al ; gel ( vVF , i ) = VF ; gel ( vVW , i ) = W ; } if ( k2 <= 1 ) al0 = zero_zv ( l - 1 ) ; return gerepilecopy ( av , mkvecn ( 7 , mf , vVW , cusps , vVF , utoipos ( bit ) , al0 , DEN ) ) ; }
mf a true mf or an fs2
mf a true mf or an fs2
/* true mf */ /* -Wall */ /* mf already an fs2, reset if its precision is too low */ /* attached to cusp 0, width N */ /* true mf */ /* paramsf[2] = w */ /* no need to test for convergence */