bridge/class-master/depend/pari/src/basemath/mftrace.c
/* Petersson product of F and G, given by mfsymbol's [k > 1 integral] */
Petersson product of F and G, given by mfsymbol's [k > 1 integral]
Petersson product of F and G given by mfsymbol ' s [ k > 1 integral ]
static GEN
mfpetersson_i(GEN FS, GEN GS)
{
  pari_sp av = avma;
  GEN mf, ESF, ESG, PF, PG, PH, CHI, cosets, vEF, vEG;
  long k, r, j, N, bitprec, prec;
  if (!checkfs_i(FS)) pari_err_TYPE("mfpetersson",FS);
  mf = fs_get_MF(FS);
  ESF = fs_get_vES(FS);
  if (!GS) GS = FS;
  else
  {
    if (!checkfs_i(GS)) pari_err_TYPE("mfpetersson",GS);
    if (!mfs_checkmf(GS, mf))
      pari_err_TYPE("mfpetersson [different mf]", mkvec2(FS,GS));
  }
  ESG = fs_get_vES(GS);
  if (!gequal0(gel(ESF,1)) && !gequal0(gel(ESG,1)))
    return mfpeterssonnoncusp(FS, GS);
  if (gequal0(gel(ESF,2)) || gequal0(gel(ESG,2))) { avma = av; return gen_0; }
  N = MF_get_N(mf);
  k = MF_get_k(mf);
  CHI = MF_get_CHI(mf);
  PF = fs_get_pols(FS); vEF = fs_get_vE(FS);
  PG = fs_get_pols(GS); vEG = fs_get_vE(GS);
  cosets = fs_get_cosets(FS);
  bitprec = minuu(fs_get_bitprec(FS), fs_get_bitprec(GS));
  prec = nbits2prec(bitprec);
  r = lg(PG)-1;
  PH = cgetg(r+1, t_VEC);
  for (j = 1; j <= r; j++)
  {
    GEN ga = gel(cosets,j), PGj1, PGjm1;
    long iT, D;
    iT = mftocoset_iD(N, ZM_mulTi(ga), cosets, &D);
    PGj1 = RgX_translate(gel(PG, iT), gen_1);
    PGj1 = RgX_Rg_mul(PGj1, mfcharcxeval(CHI, D, prec));
    iT = mftocoset_iD(N, ZM_mulT(ga), cosets, &D);
    PGjm1 = RgX_translate(gel(PG,iT), gen_m1);
    PGjm1 = RgX_Rg_mul(PGjm1, mfcharcxeval(CHI, D, prec));
    gel(PH,j) = gsub(PGj1, PGjm1);
  }
  return gerepileupto(av, gdivgs(Haberland(PF, PH, vEF, vEG, k), 6*r));
}
static GEN mfpetersson_i ( GEN FS , GEN GS ) { pari_sp av = avma ; GEN mf , ESF , ESG , PF , PG , PH , CHI , cosets , vEF , vEG ; long k , r , j , N , bitprec , prec ; if ( ! checkfs_i ( FS ) ) pari_err_TYPE ( " " , FS ) ; mf = fs_get_MF ( FS ) ; ESF = fs_get_vES ( FS ) ; if ( ! GS ) GS = FS ; else { if ( ! checkfs_i ( GS ) ) pari_err_TYPE ( " " , GS ) ; if ( ! mfs_checkmf ( GS , mf ) ) pari_err_TYPE ( " " , mkvec2 ( FS , GS ) ) ; } ESG = fs_get_vES ( GS ) ; if ( ! gequal0 ( gel ( ESF , 1 ) ) && ! gequal0 ( gel ( ESG , 1 ) ) ) return mfpeterssonnoncusp ( FS , GS ) ; if ( gequal0 ( gel ( ESF , 2 ) ) || gequal0 ( gel ( ESG , 2 ) ) ) { avma = av ; return gen_0 ; } N = MF_get_N ( mf ) ; k = MF_get_k ( mf ) ; CHI = MF_get_CHI ( mf ) ; PF = fs_get_pols ( FS ) ; vEF = fs_get_vE ( FS ) ; PG = fs_get_pols ( GS ) ; vEG = fs_get_vE ( GS ) ; cosets = fs_get_cosets ( FS ) ; bitprec = minuu ( fs_get_bitprec ( FS ) , fs_get_bitprec ( GS ) ) ; prec = nbits2prec ( bitprec ) ; r = lg ( PG ) - 1 ; PH = cgetg ( r + 1 , t_VEC ) ; for ( j = 1 ; j <= r ; j ++ ) { GEN ga = gel ( cosets , j ) , PGj1 , PGjm1 ; long iT , D ; iT = mftocoset_iD ( N , ZM_mulTi ( ga ) , cosets , & D ) ; PGj1 = RgX_translate ( gel ( PG , iT ) , gen_1 ) ; PGj1 = RgX_Rg_mul ( PGj1 , mfcharcxeval ( CHI , D , prec ) ) ; iT = mftocoset_iD ( N , ZM_mulT ( ga ) , cosets , & D ) ; PGjm1 = RgX_translate ( gel ( PG , iT ) , gen_m1 ) ; PGjm1 = RgX_Rg_mul ( PGjm1 , mfcharcxeval ( CHI , D , prec ) ) ; gel ( PH , j ) = gsub ( PGj1 , PGjm1 ) ; } return gerepileupto ( av , gdivgs ( Haberland ( PF , PH , vEF , vEG , k ) , 6 * r ) ) ; }
Petersson product of F and G, given by mfsymbol's [k > 1 integral]
Petersson product of F and G given by mfsymbol ' s [ k > 1 integral ]