bridge/class-master/depend/pari/src/basemath/base5.c
/* given a base field nf (e.g main variable y), a polynomial pol with
 * coefficients in nf    (e.g main variable x), and an order as output
 * by rnfpseudobasis, outputs a reduced order. */
given a base field nf , a polynomial pol with
coefficients in nf    , and an order as output
by rnfpseudobasis, outputs a reduced order.
given a base field nf a polynomial pol with coefficients in nf and an order as output by rnfpseudobasis outputs a reduced order .
GEN
rnflllgram(GEN nf, GEN pol, GEN order,long prec)
{
  pari_sp av = avma;
  long j, k, l, kmax, r1, lx, count = 0;
  GEN M, I, h, H, mth, MC, MPOL, MCS, B, mu;
  const long alpha = 10, MAX_COUNT = 4;
  nf = checknf(nf); r1 = nf_get_r1(nf);
  check_ZKmodule(order, "rnflllgram");
  M = gel(order,1);
  I = gel(order,2); lx = lg(I);
  if (lx < 3) return gcopy(order);
  if (lx-1 != degpol(pol)) pari_err_DIM("rnflllgram");
  I = leafcopy(I);
  H = NULL;
  MPOL = matbasistoalg(nf, M);
  MCS = matid(lx-1); 
PRECNF:
  if (count == MAX_COUNT)
  {
    prec = precdbl(prec); count = 0;
    if (DEBUGLEVEL) pari_warn(warnprec,"rnflllgram",prec);
    nf = nfnewprec_shallow(nf,prec);
  }
  mth = rel_T2(nf, pol, lx, prec);
  if (!mth) { count = MAX_COUNT; goto PRECNF; }
  h = NULL;
PRECPB:
  if (h)
  { 
    if (++count == MAX_COUNT || RgM_isidentity(h)) {count = MAX_COUNT; goto PRECNF;}
    H = H? gmul(H, h): h;
    MPOL = gmul(MPOL, h);
  }
  h = matid(lx-1);
  MC = mattocomplex(nf, MPOL);
  mu = cgetg(lx,t_MAT);
  B  = cgetg(lx,t_COL);
  for (j=1; j<lx; j++)
  {
    gel(mu,j) = zerocol(lx - 1);
    gel(B,j) = gen_0;
  }
  if (DEBUGLEVEL) err_printf("k = ");
  gel(B,1) = real_i(rnfscal(mth,gel(MC,1),gel(MC,1)));
  gel(MCS,1) = gel(MC,1);
  kmax = 1; k = 2;
  do
  {
    GEN Ik_inv = NULL;
    if (DEBUGLEVEL) err_printf("%ld ",k);
    if (k > kmax)
    { 
      kmax = k; gel(MCS,k) = gel(MC,k);
      for (j=1; j<k; j++)
      {
        gcoeff(mu,k,j) = vecdiv(rnfscal(mth,gel(MCS,j),gel(MC,k)),
                                gel(B,j));
        gel(MCS,k) = gsub(gel(MCS,k), vecmul(gcoeff(mu,k,j),gel(MCS,j)));
      }
      gel(B,k) = real_i(rnfscal(mth,gel(MCS,k),gel(MCS,k)));
      if (check_0(gel(B,k))) goto PRECPB;
    }
    if (!RED(k, k-1, h, mu, MC, nf, I, &Ik_inv)) goto PRECPB;
    if (do_SWAP(I,MC,MCS,h,mu,B,kmax,k,alpha, r1))
    {
      if (!B[k]) goto PRECPB;
      if (k > 2) k--;
    }
    else
    {
      for (l=k-2; l; l--)
        if (!RED(k, l, h, mu, MC, nf, I, &Ik_inv)) goto PRECPB;
      k++;
    }
    if (gc_needed(av,2))
    {
      if(DEBUGMEM>1) pari_warn(warnmem,"rnflllgram");
      gerepileall(av, H?10:9, &nf,&mth,&h,&MPOL,&B,&MC,&MCS,&mu,&I,&H);
    }
  }
  while (k < lx);
  MPOL = gmul(MPOL,h);
  if (H) h = gmul(H, h);
  if (DEBUGLEVEL) err_printf("\n");
  MPOL = RgM_to_nfM(nf,MPOL);
  h = RgM_to_nfM(nf,h);
  return gerepilecopy(av, mkvec2(mkvec2(MPOL,I), h));
}
GEN rnflllgram ( GEN nf , GEN pol , GEN order , long prec ) { pari_sp av = avma ; long j , k , l , kmax , r1 , lx , count = 0 ; GEN M , I , h , H , mth , MC , MPOL , MCS , B , mu ; const long alpha = 10 , MAX_COUNT = 4 ; nf = checknf ( nf ) ; r1 = nf_get_r1 ( nf ) ; check_ZKmodule ( order , " " ) ; M = gel ( order , 1 ) ; I = gel ( order , 2 ) ; lx = lg ( I ) ; if ( lx < 3 ) return gcopy ( order ) ; if ( lx - 1 != degpol ( pol ) ) pari_err_DIM ( " " ) ; I = leafcopy ( I ) ; H = NULL ; MPOL = matbasistoalg ( nf , M ) ; MCS = matid ( lx - 1 ) ; PRECNF : if ( count == MAX_COUNT ) { prec = precdbl ( prec ) ; count = 0 ; if ( DEBUGLEVEL ) pari_warn ( warnprec , " " , prec ) ; nf = nfnewprec_shallow ( nf , prec ) ; } mth = rel_T2 ( nf , pol , lx , prec ) ; if ( ! mth ) { count = MAX_COUNT ; goto PRECNF ; } h = NULL ; PRECPB : if ( h ) { if ( ++ count == MAX_COUNT || RgM_isidentity ( h ) ) { count = MAX_COUNT ; goto PRECNF ; } H = H ? gmul ( H , h ) : h ; MPOL = gmul ( MPOL , h ) ; } h = matid ( lx - 1 ) ; MC = mattocomplex ( nf , MPOL ) ; mu = cgetg ( lx , t_MAT ) ; B = cgetg ( lx , t_COL ) ; for ( j = 1 ; j < lx ; j ++ ) { gel ( mu , j ) = zerocol ( lx - 1 ) ; gel ( B , j ) = gen_0 ; } if ( DEBUGLEVEL ) err_printf ( " " ) ; gel ( B , 1 ) = real_i ( rnfscal ( mth , gel ( MC , 1 ) , gel ( MC , 1 ) ) ) ; gel ( MCS , 1 ) = gel ( MC , 1 ) ; kmax = 1 ; k = 2 ; do { GEN Ik_inv = NULL ; if ( DEBUGLEVEL ) err_printf ( " " , k ) ; if ( k > kmax ) { kmax = k ; gel ( MCS , k ) = gel ( MC , k ) ; for ( j = 1 ; j < k ; j ++ ) { gcoeff ( mu , k , j ) = vecdiv ( rnfscal ( mth , gel ( MCS , j ) , gel ( MC , k ) ) , gel ( B , j ) ) ; gel ( MCS , k ) = gsub ( gel ( MCS , k ) , vecmul ( gcoeff ( mu , k , j ) , gel ( MCS , j ) ) ) ; } gel ( B , k ) = real_i ( rnfscal ( mth , gel ( MCS , k ) , gel ( MCS , k ) ) ) ; if ( check_0 ( gel ( B , k ) ) ) goto PRECPB ; } if ( ! RED ( k , k - 1 , h , mu , MC , nf , I , & Ik_inv ) ) goto PRECPB ; if ( do_SWAP ( I , MC , MCS , h , mu , B , kmax , k , alpha , r1 ) ) { if ( ! B [ k ] ) goto PRECPB ; if ( k > 2 ) k -- ; } else { for ( l = k - 2 ; l ; l -- ) if ( ! RED ( k , l , h , mu , MC , nf , I , & Ik_inv ) ) goto PRECPB ; k ++ ; } if ( gc_needed ( av , 2 ) ) { if ( DEBUGMEM > 1 ) pari_warn ( warnmem , " " ) ; gerepileall ( av , H ? 10 : 9 , & nf , & mth , & h , & MPOL , & B , & MC , & MCS , & mu , & I , & H ) ; } } while ( k < lx ) ; MPOL = gmul ( MPOL , h ) ; if ( H ) h = gmul ( H , h ) ; if ( DEBUGLEVEL ) err_printf ( " \n " ) ; MPOL = RgM_to_nfM ( nf , MPOL ) ; h = RgM_to_nfM ( nf , h ) ; return gerepilecopy ( av , mkvec2 ( mkvec2 ( MPOL , I ) , h ) ) ; }
given a base field nf (e.g main variable y), a polynomial pol with
 coefficients in nf    (e.g main variable x), and an order as output
 by rnfpseudobasis, outputs a reduced order.
given a base field nf ( e . g main variable y ) a polynomial pol with coefficients in nf ( e . g main variable x ) and an order as output by rnfpseudobasis outputs a reduced order .
/* dummy for gerepile */ /* precision problem, recompute. If no progress, increase nf precision */ /* Incremental Gram-Schmidt */