bridge/class-master/depend/pari/src/basemath/base5.c
/* Given a torsion-free module x outputs a pseudo-basis for x in HNF */
Given a torsion-free module x outputs a pseudo-basis for x in HNF
Given a torsion - free module x outputs a pseudo - basis for x in HNF
GEN
nfhnf0(GEN nf, GEN x, long flag)
{
  long i, j, def, idef, m, n;
  pari_sp av0 = avma, av;
  GEN y, A, I, J, U;
  nf = checknf(nf);
  check_ZKmodule(x, "nfhnf");
  A = gel(x,1); RgM_dimensions(A, &m, &n);
  I = gel(x,2);
  if (!n) {
    if (!flag) return gcopy(x);
    retmkvec2(gcopy(x), cgetg(1,t_MAT));
  }
  U = flag? matid(n): NULL;
  idef = (n < m)? m-n : 0;
  av = avma;
  A = RgM_to_nfM(nf,A);
  I = leafcopy(I);
  J = zerovec(n); def = n;
  for (i=m; i>idef; i--)
  {
    GEN d, di = NULL;
    j=def; while (j>=1 && isintzero(gcoeff(A,i,j))) j--;
    if (!j)
    { 
      if (idef) idef--;
      continue;
    }
    if (j==def) j--;
    else {
      swap(gel(A,j), gel(A,def));
      swap(gel(I,j), gel(I,def));
      if (U) swap(gel(U,j), gel(U,def));
    }
    for (  ; j; j--)
    {
      GEN a,b, u,v,w, S, T, S0, T0 = gel(A,j);
      b = gel(T0,i); if (isintzero(b)) continue;
      S0 = gel(A,def); a = gel(S0,i);
      d = nfbezout(nf, a,b, gel(I,def),gel(I,j), &u,&v,&w,&di,1);
      S = colcomb(nf, u,v, S0,T0);
      T = colcomb(nf, a,gneg(b), T0,S0);
      gel(A,def) = S; gel(A,j) = T;
      gel(I,def) = d; gel(I,j) = w;
      if (U)
      {
        S0 = gel(U,def);
        T0 = gel(U,j);
        gel(U,def) = colcomb(nf, u,v, S0,T0);
        gel(U,j) = colcomb(nf, a,gneg(b), T0,S0);
      }
    }
    y = gcoeff(A,i,def);
    if (!isint1(y))
    {
      GEN yi = nfinv(nf,y);
      gel(A,def) = nfC_nf_mul(nf, gel(A,def), yi);
      gel(I,def) = idealmul(nf, y, gel(I,def));
      if (U) gel(U,def) = nfC_nf_mul(nf, gel(U,def), yi);
      di = NULL;
    }
    if (!di) di = idealinv(nf,gel(I,def));
    d = gel(I,def);
    gel(J,def) = di;
    for (j=def+1; j<=n; j++)
    {
      GEN mc, c = gcoeff(A,i,j); if (isintzero(c)) continue;
      c = element_close(nf, c, idealmul(nf,d,gel(J,j)));
      mc = gneg(c);
      gel(A,j) = colcomb1(nf, mc, gel(A,j),gel(A,def));
      if (U) gel(U,j) = colcomb1(nf, mc, gel(U,j),gel(U,def));
    }
    def--;
    if (gc_needed(av,2))
    {
      if(DEBUGMEM>1) pari_warn(warnmem,"nfhnf, i = %ld", i);
      gerepileall(av,U?4:3, &A,&I,&J,&U);
    }
  }
  n -= def;
  A += def; A[0] = evaltyp(t_MAT)|evallg(n+1);
  I += def; I[0] = evaltyp(t_VEC)|evallg(n+1);
  idV_simplify(I);
  x = mkvec2(A,I);
  if (U) x = mkvec2(x,U);
  return gerepilecopy(av0, x);
}
GEN nfhnf0 ( GEN nf , GEN x , long flag ) { long i , j , def , idef , m , n ; pari_sp av0 = avma , av ; GEN y , A , I , J , U ; nf = checknf ( nf ) ; check_ZKmodule ( x , " " ) ; A = gel ( x , 1 ) ; RgM_dimensions ( A , & m , & n ) ; I = gel ( x , 2 ) ; if ( ! n ) { if ( ! flag ) return gcopy ( x ) ; retmkvec2 ( gcopy ( x ) , cgetg ( 1 , t_MAT ) ) ; } U = flag ? matid ( n ) : NULL ; idef = ( n < m ) ? m - n : 0 ; av = avma ; A = RgM_to_nfM ( nf , A ) ; I = leafcopy ( I ) ; J = zerovec ( n ) ; def = n ; for ( i = m ; i > idef ; i -- ) { GEN d , di = NULL ; j = def ; while ( j >= 1 && isintzero ( gcoeff ( A , i , j ) ) ) j -- ; if ( ! j ) { if ( idef ) idef -- ; continue ; } if ( j == def ) j -- ; else { swap ( gel ( A , j ) , gel ( A , def ) ) ; swap ( gel ( I , j ) , gel ( I , def ) ) ; if ( U ) swap ( gel ( U , j ) , gel ( U , def ) ) ; } for ( ; j ; j -- ) { GEN a , b , u , v , w , S , T , S0 , T0 = gel ( A , j ) ; b = gel ( T0 , i ) ; if ( isintzero ( b ) ) continue ; S0 = gel ( A , def ) ; a = gel ( S0 , i ) ; d = nfbezout ( nf , a , b , gel ( I , def ) , gel ( I , j ) , & u , & v , & w , & di , 1 ) ; S = colcomb ( nf , u , v , S0 , T0 ) ; T = colcomb ( nf , a , gneg ( b ) , T0 , S0 ) ; gel ( A , def ) = S ; gel ( A , j ) = T ; gel ( I , def ) = d ; gel ( I , j ) = w ; if ( U ) { S0 = gel ( U , def ) ; T0 = gel ( U , j ) ; gel ( U , def ) = colcomb ( nf , u , v , S0 , T0 ) ; gel ( U , j ) = colcomb ( nf , a , gneg ( b ) , T0 , S0 ) ; } } y = gcoeff ( A , i , def ) ; if ( ! isint1 ( y ) ) { GEN yi = nfinv ( nf , y ) ; gel ( A , def ) = nfC_nf_mul ( nf , gel ( A , def ) , yi ) ; gel ( I , def ) = idealmul ( nf , y , gel ( I , def ) ) ; if ( U ) gel ( U , def ) = nfC_nf_mul ( nf , gel ( U , def ) , yi ) ; di = NULL ; } if ( ! di ) di = idealinv ( nf , gel ( I , def ) ) ; d = gel ( I , def ) ; gel ( J , def ) = di ; for ( j = def + 1 ; j <= n ; j ++ ) { GEN mc , c = gcoeff ( A , i , j ) ; if ( isintzero ( c ) ) continue ; c = element_close ( nf , c , idealmul ( nf , d , gel ( J , j ) ) ) ; mc = gneg ( c ) ; gel ( A , j ) = colcomb1 ( nf , mc , gel ( A , j ) , gel ( A , def ) ) ; if ( U ) gel ( U , j ) = colcomb1 ( nf , mc , gel ( U , j ) , gel ( U , def ) ) ; } def -- ; if ( gc_needed ( av , 2 ) ) { if ( DEBUGMEM > 1 ) pari_warn ( warnmem , " " , i ) ; gerepileall ( av , U ? 4 : 3 , & A , & I , & J , & U ) ; } } n -= def ; A += def ; A [ 0 ] = evaltyp ( t_MAT ) | evallg ( n + 1 ) ; I += def ; I [ 0 ] = evaltyp ( t_VEC ) | evallg ( n + 1 ) ; idV_simplify ( I ) ; x = mkvec2 ( A , I ) ; if ( U ) x = mkvec2 ( x , U ) ; return gerepilecopy ( av0 , x ) ; }
Given a torsion-free module x outputs a pseudo-basis for x in HNF
Given a torsion - free module x outputs a pseudo - basis for x in HNF
/* no pivot on line i */