bridge/class-master/depend/pari/src/basemath/lfun.c
/* assume lmisc is an linit, s went through get_domain and s/bitprec belong
 * to domain */
assume lmisc is an linit, s went through get_domain and s/bitprec belong
to domain
assume lmisc is an linit s went through get_domain and s / bitprec belong to domain
static GEN
lfunlambda_OK(GEN linit, GEN s, GEN sdom, long bitprec)
{
  GEN eno, ldata, tech, h, pol;
  GEN S, S0 = NULL, k2, cost;
  long prec, prec0;
  struct lfunp D, D0;
  if (linit_get_type(linit) == t_LDESC_PRODUCT)
    return lfunlambda_product(linit, s, sdom, bitprec);
  ldata = linit_get_ldata(linit);
  eno = ldata_get_rootno(ldata);
  tech = linit_get_tech(linit);
  h = lfun_get_step(tech); prec = realprec(h);
  parse_dom(0, sdom, &D0);
  parse_dom(0, domain_get_dom(lfun_get_domain(tech)), &D);
  if (0.8 * D.dh > D0.dh)
  {
    cost = lfuncost(linit, sdom, typ(s)==t_SER? der_level(s): 0, bitprec);
    prec0 = nbits2prec(cost[2]);
    if (prec0 < prec) { prec = prec0; h = gprec_w(h, prec); }
  }
  pol = lfun_get_pol(tech);
  s = gprec_w(s, prec);
  if (ldata_get_residue(ldata))
  {
    GEN R = lfun_get_Residue(tech);
    GEN Ra = lfunpoleresidue(R, s);
    if (Ra) return gprec_w(Ra, nbits2prec(bitprec));
    S0 = lfunsumcoth(R, s, h, prec);
  }
  k2 = lfun_get_k2(tech);
  if (typ(pol)==t_POL && typ(s) != t_SER && gequal(real_i(s), k2))
  { 
    GEN polz, b = imag_i(s);
    polz = gequal0(b)? poleval(pol,gen_1): poleval(pol, expIr(gmul(h,b)));
    S = gadd(polz, gmul(eno, conj_i(polz)));
  }
  else
  {
    GEN z = gexp(gmul(h, gsub(s, k2)), prec);
    GEN zi = ginv(z), zc = conj_i(zi);
    if (typ(pol)==t_POL)
      S = gadd(poleval(pol, z), gmul(eno, conj_i(poleval(pol, zc))));
    else
      S = gadd(poleval(gel(pol,1), z), gmul(eno, poleval(gel(pol,2), zi)));
  }
  if (S0) S = gadd(S,S0);
  return gprec_w(gmul(S,h), nbits2prec(bitprec));
}
static GEN lfunlambda_OK ( GEN linit , GEN s , GEN sdom , long bitprec ) { GEN eno , ldata , tech , h , pol ; GEN S , S0 = NULL , k2 , cost ; long prec , prec0 ; struct lfunp D , D0 ; if ( linit_get_type ( linit ) == t_LDESC_PRODUCT ) return lfunlambda_product ( linit , s , sdom , bitprec ) ; ldata = linit_get_ldata ( linit ) ; eno = ldata_get_rootno ( ldata ) ; tech = linit_get_tech ( linit ) ; h = lfun_get_step ( tech ) ; prec = realprec ( h ) ; parse_dom ( 0 , sdom , & D0 ) ; parse_dom ( 0 , domain_get_dom ( lfun_get_domain ( tech ) ) , & D ) ; if ( 0.8 * D . dh > D0 . dh ) { cost = lfuncost ( linit , sdom , typ ( s ) == t_SER ? der_level ( s ) : 0 , bitprec ) ; prec0 = nbits2prec ( cost [ 2 ] ) ; if ( prec0 < prec ) { prec = prec0 ; h = gprec_w ( h , prec ) ; } } pol = lfun_get_pol ( tech ) ; s = gprec_w ( s , prec ) ; if ( ldata_get_residue ( ldata ) ) { GEN R = lfun_get_Residue ( tech ) ; GEN Ra = lfunpoleresidue ( R , s ) ; if ( Ra ) return gprec_w ( Ra , nbits2prec ( bitprec ) ) ; S0 = lfunsumcoth ( R , s , h , prec ) ; } k2 = lfun_get_k2 ( tech ) ; if ( typ ( pol ) == t_POL && typ ( s ) != t_SER && gequal ( real_i ( s ) , k2 ) ) { GEN polz , b = imag_i ( s ) ; polz = gequal0 ( b ) ? poleval ( pol , gen_1 ) : poleval ( pol , expIr ( gmul ( h , b ) ) ) ; S = gadd ( polz , gmul ( eno , conj_i ( polz ) ) ) ; } else { GEN z = gexp ( gmul ( h , gsub ( s , k2 ) ) , prec ) ; GEN zi = ginv ( z ) , zc = conj_i ( zi ) ; if ( typ ( pol ) == t_POL ) S = gadd ( poleval ( pol , z ) , gmul ( eno , conj_i ( poleval ( pol , zc ) ) ) ) ; else S = gadd ( poleval ( gel ( pol , 1 ) , z ) , gmul ( eno , poleval ( gel ( pol , 2 ) , zi ) ) ) ; } if ( S0 ) S = gadd ( S , S0 ) ; return gprec_w ( gmul ( S , h ) , nbits2prec ( bitprec ) ) ; }
assume lmisc is an linit, s went through get_domain and s/bitprec belong
 to domain
assume lmisc is an linit s went through get_domain and s / bitprec belong to domain
/* try to reduce accuracy */ /* on critical line: shortcut */