bridge/class-master/depend/pari/src/basemath/mftrace.c
/* F1S, F2S both symbols, same mf */
F1S, F2S both symbols, same mf
F1S F2S both symbols same mf
static GEN
mfpeterssonnoncusp(GEN F1S, GEN F2S)
{
  pari_sp av = avma;
  GEN mf, F1, F2, GF1, GF2, P2, cosets, vE1, vE2, FE1, FE2, P;
  GEN I, IP1, RHO, RHOP1, INF, res, ress;
  const double height = sqrt(3.)/2;
  long k, r, j, bitprec, prec;
  mf = fs_get_MF(F1S);
  FE1 = fs_get_EF(F1S); F1 = gel(FE1, 1);
  FE2 = fs_get_EF(F2S); F2 = gel(FE2, 1);
  cosets = fs_get_cosets(F1S);
  bitprec = minuu(fs_get_bitprec(F1S), fs_get_bitprec(F2S));
  prec = nbits2prec(bitprec);
  F1S = fs_set_expan(F1S, mfgaexpansionall(mf, FE1, cosets, height, prec));
  if (F2S != F1S)
    F2S = fs_set_expan(F2S, mfgaexpansionall(mf, FE2, cosets, height, prec));
  k = MF_get_k(mf); r = lg(cosets) - 1;
  vE1 = fs_get_vE(F1S);
  vE2 = fs_get_vE(F2S);
  I = gen_I();
  IP1 = mkcomplex(gen_1,gen_1);
  RHO = rootsof1u_cx(3, prec+1);
  RHOP1 = gaddsg(1, RHO);
  INF = mkoo();
  mffvanish(mf, F1, F2, cosets, &res, &ress);
  P2 = fs_get_pols(F2S);
  GF1 = cgetg(r+1, t_VEC);
  GF2 = cgetg(r+1, t_VEC); P = get_P(k, fetch_var(), prec);
  for (j = 1; j <= r; j++)
  {
    GEN g = gel(cosets,j);
    if (res[j]) {
      gel(GF1,j) = mfsymboleval_direct(F1S, mkvec2(RHOP1,INF), g, P);
      gel(GF2,j) = mfsymboleval_direct(F2S, mkvec2(I,IP1), g, P);
    } else if (ress[j]) {
      gel(GF1,j) = mfsymboleval_direct(F1S, mkvec2(RHOP1,RHO), g, P);
      gel(GF2,j) = mfsymboleval_direct(F2S, mkvec2(I,INF), g, P);
    } else {
      gel(GF1,j) = mfsymboleval_direct(F1S, mkvec2(RHO,I), g, P);
      gel(GF2,j) = gneg(gel(P2,j)); 
    }
  }
  delete_var();
  return gerepileupto(av, gdivgs(Haberland(GF1,GF2, vE1,vE2, k), r));
}
static GEN mfpeterssonnoncusp ( GEN F1S , GEN F2S ) { pari_sp av = avma ; GEN mf , F1 , F2 , GF1 , GF2 , P2 , cosets , vE1 , vE2 , FE1 , FE2 , P ; GEN I , IP1 , RHO , RHOP1 , INF , res , ress ; const double height = sqrt ( 3. ) / 2 ; long k , r , j , bitprec , prec ; mf = fs_get_MF ( F1S ) ; FE1 = fs_get_EF ( F1S ) ; F1 = gel ( FE1 , 1 ) ; FE2 = fs_get_EF ( F2S ) ; F2 = gel ( FE2 , 1 ) ; cosets = fs_get_cosets ( F1S ) ; bitprec = minuu ( fs_get_bitprec ( F1S ) , fs_get_bitprec ( F2S ) ) ; prec = nbits2prec ( bitprec ) ; F1S = fs_set_expan ( F1S , mfgaexpansionall ( mf , FE1 , cosets , height , prec ) ) ; if ( F2S != F1S ) F2S = fs_set_expan ( F2S , mfgaexpansionall ( mf , FE2 , cosets , height , prec ) ) ; k = MF_get_k ( mf ) ; r = lg ( cosets ) - 1 ; vE1 = fs_get_vE ( F1S ) ; vE2 = fs_get_vE ( F2S ) ; I = gen_I ( ) ; IP1 = mkcomplex ( gen_1 , gen_1 ) ; RHO = rootsof1u_cx ( 3 , prec + 1 ) ; RHOP1 = gaddsg ( 1 , RHO ) ; INF = mkoo ( ) ; mffvanish ( mf , F1 , F2 , cosets , & res , & ress ) ; P2 = fs_get_pols ( F2S ) ; GF1 = cgetg ( r + 1 , t_VEC ) ; GF2 = cgetg ( r + 1 , t_VEC ) ; P = get_P ( k , fetch_var ( ) , prec ) ; for ( j = 1 ; j <= r ; j ++ ) { GEN g = gel ( cosets , j ) ; if ( res [ j ] ) { gel ( GF1 , j ) = mfsymboleval_direct ( F1S , mkvec2 ( RHOP1 , INF ) , g , P ) ; gel ( GF2 , j ) = mfsymboleval_direct ( F2S , mkvec2 ( I , IP1 ) , g , P ) ; } else if ( ress [ j ] ) { gel ( GF1 , j ) = mfsymboleval_direct ( F1S , mkvec2 ( RHOP1 , RHO ) , g , P ) ; gel ( GF2 , j ) = mfsymboleval_direct ( F2S , mkvec2 ( I , INF ) , g , P ) ; } else { gel ( GF1 , j ) = mfsymboleval_direct ( F1S , mkvec2 ( RHO , I ) , g , P ) ; gel ( GF2 , j ) = gneg ( gel ( P2 , j ) ) ; } } delete_var ( ) ; return gerepileupto ( av , gdivgs ( Haberland ( GF1 , GF2 , vE1 , vE2 , k ) , r ) ) ; }
F1S, F2S both symbols, same mf
F1S F2S both symbols same mf
/* - symboleval(F2S, [0,oo] */