OpenXM_contrib2/asir2000/builtin/gr.c - diff

Return to gr.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/gr.c between version 1.2 and 1.72

-version 1.2, 2000/04/13 06:01:01
+version 1.72, 2016/08/08 07:18:10
 Line 1
 Line 1
 Line 1
- /* $OpenXM: OpenXM_contrib2/asir2000/builtin/gr.c,v 1.1.1.1 1999/12/03 07:39:07 noro Exp $ */
+ /*
+  * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
+  * All rights reserved.
+  *
+  * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
+  * non-exclusive and royalty-free license to use, copy, modify and
+  * redistribute, solely for non-commercial and non-profit purposes, the
+  * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
+  * conditions of this Agreement. For the avoidance of doubt, you acquire
+  * only a limited right to use the SOFTWARE hereunder, and FLL or any
+  * third party developer retains all rights, including but not limited to
+  * copyrights, in and to the SOFTWARE.
+  *
+  * (1) FLL does not grant you a license in any way for commercial
+  * purposes. You may use the SOFTWARE only for non-commercial and
+  * non-profit purposes only, such as academic, research and internal
+  * business use.
+  * (2) The SOFTWARE is protected by the Copyright Law of Japan and
+  * international copyright treaties. If you make copies of the SOFTWARE,
+  * with or without modification, as permitted hereunder, you shall affix
+  * to all such copies of the SOFTWARE the above copyright notice.
+  * (3) An explicit reference to this SOFTWARE and its copyright owner
+  * shall be made on your publication or presentation in any form of the
+  * results obtained by use of the SOFTWARE.
+  * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
+  * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
+  * for such modification or the source code of the modified part of the
+  * SOFTWARE.
+  *
+  * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
+  * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
+  * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
+  * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
+  * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
+  * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
+  * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
+  * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
+  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
+  * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
+  * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
+  * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
+  * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
+  * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
+  * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
+  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
+  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
+  *
+  * $OpenXM: OpenXM_contrib2/asir2000/builtin/gr.c,v 1.71 2015/08/14 13:51:54 fujimoto Exp $
+ */
  #include "ca.h"
  #include "parse.h"
  #include "base.h"
  #include "ox.h"
- #define ITOS(p) (((unsigned int)(p))&0x7fffffff)
+ #if defined(__GNUC__)
- #define STOI(i) ((P)((unsigned int)(i)|0x80000000))
+ #define INLINE static inline
+ #elif defined(VISUAL) || defined(__MINGW32__)
+ #define INLINE __inline
+ #else
+ #define INLINE
+ #endif
- #define NEXTVL(r,c) \
- if(!(r)){NEWVL(r);(c)=(r);}else{NEWVL(NEXT(c));(c)=NEXT(c);}
  #define HMAG(p) (p_mag(BDY(p)->c))
- struct dp_pairs {
+ #define NEWDP_pairs ((DP_pairs)MALLOC(sizeof(struct dp_pairs)))
-         int dp1, dp2;
-         DL lcm;
-         int sugar;
-         struct dp_pairs *next;
- };
- typedef struct dp_pairs *DP_pairs;
+ static DP_pairs collect_pairs_of_hdlcm( DP_pairs d1, DP_pairs *prest );
+ double get_rtime();
- #define NEWDPP(a) ((a)=(DP_pairs)MALLOC(sizeof(struct dp_pairs)))
+ struct oEGT eg_nf,eg_nfm;
+ struct oEGT eg_znfm,eg_pz,eg_np,eg_ra,eg_mc,eg_gc;
+ int TP,N_BP,NMP,NFP,NDP,ZR,NZR;
- #define NEXTDPP(r,c) \
- if(!(r)){NEWDPP(r);(c)=(r);}else{NEWDPP(NEXT(c));(c)=NEXT(c);}
- struct oEGT eg_up,eg_sp,eg_spm,eg_nf,eg_nfm;
- struct oEGT eg_znfm,eg_pz,eg_np,eg_mp,eg_ra,eg_mc,eg_gc;
- int TP,NBP,NMP,NFP,NDP,ZR,NZR;
- #define NEWDP_pairs ((DP_pairs)MALLOC(sizeof(struct dp_pairs)))
  extern int (*cmpdl)();
+ extern int do_weyl;
- void Pdp_gr_flags(), Pdp_gr_print();
+ extern DP_Print;
- void Pdp_gr_main(),Pdp_gr_mod_main(),Pdp_f4_main(),Pdp_f4_mod_main();
- void print_stat(void);
- void init_stat(void);
- int dp_load_t(int,DP *);
- void dp_load(int,DP *);
- void dp_save(int,DP);
- void dp_make_flaglist(LIST *);
- void dp_set_flag(Obj,Obj);
- int membercheck(NODE,NODE);
- int gbcheck(NODE);
- int dl_redble(DL,DL);
- NODE remove_reducibles(NODE,int);
- NODE updbase(NODE,int);
- DP_pairs criterion_F(DP_pairs);
- int criterion_2(int,int);
- static DP_pairs collect_pairs_of_hdlcm(DP_pairs,DP_pairs *);
- DP_pairs criterion_M(DP_pairs);
- DP_pairs criterion_B(DP_pairs,int);
- DP_pairs newpairs(NODE,int);
- DP_pairs updpairs(DP_pairs,NODE,int);
- void _dp_nf_ptozp(NODE,DP,DP *,int,int,DP *);
- void _dp_nf_ptozp_mpi(NODE,DP,DP *,int,int,DP *);
- void _dp_nf(NODE,DP,DP *,int,DP *);
- void _dp_nf_mod(NODE,DP,DP *,int,int,DP *);
- void interreduce_mod(NODE,int,int);
- NODE gb_mod(NODE,int);
- NODE gbd(NODE,int,NODE,NODE);
- NODE gb(NODE,int,NODE);
- NODE gb_f4(NODE);
- NODE gb_f4_mod(NODE,int);
- DP_pairs minp(DP_pairs, DP_pairs *);
- void minsugar(DP_pairs,DP_pairs *,DP_pairs *);
- NODE append_one(NODE,int);
- void reducebase_dehomo(NODE,NODE *);
- int newps_mod(DP,int);
- int newps_nosave(DP,int,NODE);
- int newps(DP,int,NODE);
- void reduceall_mod(NODE,int,NODE *);
- void reduceall(NODE,NODE *);
- NODE NODE_sortbi(NODE,int);
- NODE NODE_sortbi_insert(int, NODE,int);
- NODE NODE_sortb(NODE,int);
- NODE NODE_sortb_insert(DP,NODE,int);
- void prim_part(DP,int,DP *);
- void setup_arrays(NODE,int,NODE *);
- int validhc(P,int,NODE);
- void vlminus(VL,VL,VL *);
- void printsubst(NODE);
- void makesubst(VL,NODE *);
- void pltovl(LIST,VL *);
- void printdl(DL);
- int DPPlength(DP_pairs);
- void dp_gr_mod_main(LIST,LIST,Num,int,struct order_spec *,LIST *);
- void dp_gr_main(LIST,LIST,Num,int,struct order_spec *,LIST *);
- void dp_f4_main(LIST,LIST,struct order_spec *,LIST *);
- void dp_f4_mod_main(LIST,LIST,int,struct order_spec *,LIST *);
- double get_rtime();
- void _dpmod_to_vect(DP,DL *,int *);
- void dp_to_vect(DP,DL *,Q *);
- NODE dp_dllist(DP f),symb_merge(NODE,NODE,int);
  extern int dp_nelim;
  extern int dp_fcoeffs;
  static DP *ps,*psm;
-Line 105  static P *psc;
+Line 84  static P *psc;
 Line 105  static P *psc;
 Line 84  static P *psc;
  static int *pss;
  static int psn,pslen;
- static int NVars,CNVars,PCoeffs;
+ static int NVars,CNVars;
  static VL VC;
- static int NoSugar = 0;
+ int PCoeffs;
+ int DP_Print = 0;
+ int DP_PrintShort = 0;
+ int DP_Multiple = 0;
+ int DP_NFStat = 0;
+ LIST Dist = 0;
+ int NoGCD = 0;
+ int GenTrace = 0;
+ int GenSyz = 0;
+ int OXCheck = -1;
+ int OneZeroHomo = 0;
+ int MaxDeg = 0;
+ int NoSugar = 0;
  static int NoCriB = 0;
  static int NoGC = 0;
  static int NoMC = 0;
  static int NoRA = 0;
- int Print = 0;
- static int PrintShort = 0;
  static int ShowMag = 0;
  static int Stat = 0;
- static int Multiple = 0;
+ int Denominator = 1;
- static int Denominator = 1;
+ int Top = 0;
- static int Top = 0;
+ int Reverse = 0;
- static int Reverse = 0;
- static int InterReduce = 0;
  static int Max_mag = 0;
- static char *Demand = 0;
+ static int Max_coef = 0;
+ char *Demand = 0;
  static int PtozpRA = 0;
- LIST Dist = 0;
- int NoGCD = 0;
  int doing_f4;
+ NODE TraceList;
+ NODE AllTraceList;
- void Pdp_gr_flags(arg,rp)
+ void Pox_cmo_rpc(NODE,Obj *);
- NODE arg;
+ void Pox_rpc(NODE,Obj *);
- LIST *rp;
+ void Pox_pop_local(NODE,Obj *);
+ INLINE int eqdl(int nv,DL dl1,DL dl2)
  {
-         Obj name,value;
+         int i;
-         NODE n;
+         int *p1,*p2;
-         if ( arg ) {
+         if ( dl1->td != dl2->td )
-                 asir_assert(ARG0(arg),O_LIST,"dp_gr_flags");
+                 return 0;
-                 n = BDY((LIST)ARG0(arg));
+         i = nv-1;
-                 while ( n ) {
+         p1 = dl1->d;
-                         name = (Obj)BDY(n); n = NEXT(n);
+         p2 = dl2->d;
-                         if ( !n )
+         while ( i >= 7 ) {
-                                 break;
+                 if ( *p1++ != *p2++ ) return 0;
-                         else {
+                 if ( *p1++ != *p2++ ) return 0;
-                                 value = (Obj)BDY(n); n = NEXT(n);
+                 if ( *p1++ != *p2++ ) return 0;
-                         }
+                 if ( *p1++ != *p2++ ) return 0;
-                         dp_set_flag(name,value);
+                 if ( *p1++ != *p2++ ) return 0;
-                 }
+                 if ( *p1++ != *p2++ ) return 0;
+                 if ( *p1++ != *p2++ ) return 0;
+                 if ( *p1++ != *p2++ ) return 0;
+                 i -= 8;
          }
-         dp_make_flaglist(rp);
+         switch ( i ) {
+                 case 6:
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         return 1;
+                 case 5:
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         return 1;
+                 case 4:
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         return 1;
+                 case 3:
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         return 1;
+                 case 2:
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         return 1;
+                 case 1:
+                         if ( *p1++ != *p2++ ) return 0;
+                         if ( *p1++ != *p2++ ) return 0;
+                         return 1;
+                 case 0:
+                         if ( *p1++ != *p2++ ) return 0;
+                         return 1;
+                 default:
+                         return 1;
+         }
  }
- void Pdp_gr_print(arg,rp)
+ /* b[] should be cleared */
- NODE arg;
- Q *rp;
- {
-         Q q;
-         if ( arg ) {
+ void _dpmod_to_vect(DP f,DL *at,int *b)
-                 asir_assert(ARG0(arg),O_N,"dp_gr_print");
-                 q = (Q)ARG0(arg); Print = QTOS(q);
-         } else
-                 STOQ(Print,q);
-         *rp = q;
- }
- void Pdp_gr_main(arg,rp)
- NODE arg;
- LIST *rp;
  {
-         LIST f,v;
+         int i,nv;
-         Num homo;
+         MP m;
-         Q m;
-         int modular;
-         struct order_spec ord;
-         asir_assert(ARG0(arg),O_LIST,"dp_gr_main");
+         nv = f->nv;
-         asir_assert(ARG1(arg),O_LIST,"dp_gr_main");
+         for ( m = BDY(f), i = 0; m; m = NEXT(m), i++ ) {
-         asir_assert(ARG2(arg),O_N,"dp_gr_main");
+                 for ( ; !eqdl(nv,m->dl,at[i]); i++ );
-         asir_assert(ARG3(arg),O_N,"dp_gr_main");
+                 b[i] = ITOS(m->c);
-         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
+         }
-         homo = (Num)ARG2(arg);
-         m = (Q)ARG3(arg);
-         if ( !m )
-                 modular = 0;
-         else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )
-                 error("dp_gr_main : too large modulus");
-         else
-                 modular = QTOS(m);
-         create_order_spec(ARG4(arg),&ord);
-         dp_gr_main(f,v,homo,modular,&ord,rp);
  }
- void Pdp_f4_main(arg,rp)
+ /* [t,findex] -> tf -> compressed vector */
- NODE arg;
- LIST *rp;
- {
-         LIST f,v;
-         struct order_spec ord;
-         asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
+ void _tf_to_vect_compress(NODE tf,DL *at,CDP *b)
-         asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
-         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
-         create_order_spec(ARG2(arg),&ord);
-         dp_f4_main(f,v,&ord,rp);
- }
- void Pdp_f4_mod_main(arg,rp)
- NODE arg;
- LIST *rp;
  {
-         LIST f,v;
+         int i,j,k,nv,len;
-         int m;
+         DL t,s,d1;
-         struct order_spec ord;
+         DP f;
+         MP m;
+         CDP r;
-         asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
+         t = (DL)BDY(tf);
-         asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
+         f = ps[(int)BDY(NEXT(tf))];
-         asir_assert(ARG2(arg),O_N,"dp_f4_main");
-         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));
-         create_order_spec(ARG3(arg),&ord);
-         dp_f4_mod_main(f,v,m,&ord,rp);
- }
- void Pdp_gr_mod_main(arg,rp)
+         nv = f->nv;
- NODE arg;
+         for ( m = BDY(f), len = 0; m; m = NEXT(m), len++ );
- LIST *rp;
+         r = (CDP)MALLOC(sizeof(struct oCDP));
- {
+         r->len = len;
-         LIST f,v;
+         r->psindex = (int)BDY(NEXT(tf));
-         Num homo;
+         r->body = (unsigned int *)MALLOC_ATOMIC(sizeof(unsigned int)*len);
-         int m;
-         struct order_spec ord;
-         asir_assert(ARG0(arg),O_LIST,"dp_gr_mod_main");
+         NEWDL_NOINIT(s,nv);
-         asir_assert(ARG1(arg),O_LIST,"dp_gr_mod_main");
+         for ( m = BDY(f), i = j = 0; m; m = NEXT(m), j++ ) {
-         asir_assert(ARG2(arg),O_N,"dp_gr_mod_main");
+                 d1 = m->dl;
-         asir_assert(ARG3(arg),O_N,"dp_gr_mod_main");
+                 s->td = t->td+d1->td;
-         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
+                 for ( k = 0; k < nv; k++ )
-         homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));
+                         s->d[k] = t->d[k]+d1->d[k];
-         create_order_spec(ARG4(arg),&ord);
+                 for ( ; !eqdl(nv,s,at[i]); i++ );
-         dp_gr_mod_main(f,v,homo,m,&ord,rp);
+                 r->body[j] = i;
+         }
+         *b = r;
  }
- int eqdl(nv,dl1,dl2)
+ void dp_to_vect(DP f,DL *at,Q *b)
- int nv;
- DL dl1,dl2;
  {
-         int i;
-         int *b1,*b2;
-         if ( dl1->td != dl2->td )
-                 return 0;
-         for ( i = 0, b1 = dl1->d, b2 = dl2->d; i < nv; i++ )
-                 if ( b1[i] != b2[i] )
-                         break;
-         if ( i == nv )
-                 return 1;
-         else
-                 return 0;
- }
- void _dpmod_to_vect(f,at,b)
- DP f;
- DL *at;
- int *b;
- {
          int i,nv;
          MP m;
          nv = f->nv;
          for ( m = BDY(f), i = 0; m; m = NEXT(m), i++ ) {
                  for ( ; !eqdl(nv,m->dl,at[i]); i++ );
-                 b[i] = ITOS(m->c);
+                 b[i] =(Q)m->c;
          }
  }
- void dp_to_vect(f,at,b)
+ NODE dp_dllist(DP f)
- DP f;
- DL *at;
- Q *b;
  {
-         int i,nv;
          MP m;
+         NODE mp,mp0;
-         nv = f->nv;
+         if ( !f )
-         for ( m = BDY(f), i = 0; m; m = NEXT(m), i++ ) {
+                 return 0;
-                 for ( ; !eqdl(nv,m->dl,at[i]); i++ );
+         mp0 = 0;
-                 b[i] =(Q)m->c;
+         for ( m = BDY(f); m; m = NEXT(m) ) {
+                 NEXTNODE(mp0,mp); BDY(mp) = (pointer)m->dl;
          }
+         NEXT(mp) = 0;
+         return mp0;
  }
- NODE dp_dllist(f)
+ NODE mul_dllist(DL d,DP f)
- DP f;
  {
          MP m;
          NODE mp,mp0;
+         DL t,d1;
+         int i,nv;
          if ( !f )
                  return 0;
+         nv = NV(f);
          mp0 = 0;
          for ( m = BDY(f); m; m = NEXT(m) ) {
-                 NEXTNODE(mp0,mp); BDY(mp) = (pointer)m->dl;
+                 NEXTNODE(mp0,mp);
+                 NEWDL_NOINIT(t,nv);
+                 d1 = m->dl;
+                 t->td = d->td+d1->td;
+                 for ( i = 0; i < nv; i++ )
+                         t->d[i] = d->d[i]+d1->d[i];
+                 BDY(mp) = (pointer)t;
          }
          NEXT(mp) = 0;
          return mp0;
  }
- void pdl(f)
+ void pdl(NODE f)
- NODE f;
  {
          while ( f ) {
                  printdl(BDY(f)); f = NEXT(f);
-Line 315  NODE f;
+Line 298  NODE f;
 Line 315  NODE f;
 Line 298  NODE f;
          printf("\n");
  }
- void dp_gr_main(f,v,homo,modular,ord,rp)
+ void dp_gr_main(LIST f,LIST v,Num homo,int modular,int field,struct order_spec *ord,LIST *rp)
- LIST f,v;
- Num homo;
- int modular;
- struct order_spec *ord;
- LIST *rp;
  {
          int i,mindex,m,nochk;
-         struct order_spec ord1;
+         struct order_spec *ord1;
+         Q q;
          VL fv,vv,vc;
          NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
+         NODE ind,ind0;
+         LIST trace,gbindex;
+         int input_is_dp = 0;
-         mindex = 0; nochk = 0; dp_fcoeffs = 0;
+         mindex = 0; nochk = 0; dp_fcoeffs = field;
          get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
          NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
          CNVars = homo ? NVars+1 : NVars;
-Line 338  LIST *rp;
+Line 320  LIST *rp;
 Line 338  LIST *rp;
 Line 320  LIST *rp;
                  homogenize_order(ord,NVars,&ord1);
                  for ( fd0 = fi0 = 0, t = BDY(f); t; t = NEXT(t) ) {
                          NEXTNODE(fd0,fd); NEXTNODE(fi0,fi);
-                         ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fi)); dp_homo((DP)BDY(fi),(DP *)&BDY(fd));
+                         if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+                                 dp_sort((DP)BDY(t),(DP *)&BDY(fi)); input_is_dp = 1;
+                         } else
+                                 ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fi));
+                         dp_homo((DP)BDY(fi),(DP *)&BDY(fd));
                  }
                  if ( fd0 ) NEXT(fd) = 0;
                  if ( fi0 ) NEXT(fi) = 0;
-                 initd(&ord1);
+                 initd(ord1);
          } else {
                  for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
-                         NEXTNODE(fd0,fd); ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
+                         NEXTNODE(fd0,fd);
+                         if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+                                 dp_sort((DP)BDY(t),(DP *)&BDY(fd)); input_is_dp = 1;
+                         } else
+                                 ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
                  }
                  if ( fd0 ) NEXT(fd) = 0;
                  fi0 = fd0;
-Line 354  LIST *rp;
+Line 344  LIST *rp;
 Line 354  LIST *rp;
 Line 344  LIST *rp;
                  modular = -modular; nochk = 1;
          }
          if ( modular )
-                 m = modular > 1 ? modular : lprime[mindex];
+                 m = modular > 1 ? modular : get_lprime(mindex);
          else
                  m = 0;
          makesubst(vc,&subst);
-Line 362  LIST *rp;
+Line 352  LIST *rp;
 Line 362  LIST *rp;
 Line 352  LIST *rp;
          init_stat();
          while ( 1 ) {
                  if ( homo ) {
-                         initd(&ord1); CNVars = NVars+1;
+                         initd(ord1); CNVars = NVars+1;
                  }
-                 if ( Print && modular ) {
+                 if ( DP_Print && modular ) {
                          fprintf(asir_out,"mod= %d, eval = ",m); printsubst(subst);
                  }
                  x = gb(s,m,subst);
-Line 384  LIST *rp;
+Line 374  LIST *rp;
 Line 384  LIST *rp;
 Line 374  LIST *rp;
                          if ( modular > 1 ) {
                                  *rp = 0; return;
                          } else
-                                 m = lprime[++mindex];
+                                 m = get_lprime(++mindex);
                  makesubst(vc,&subst);
                  psn = length(s);
                  for ( i = psn; i < pslen; i++ ) {
                          pss[i] = 0; psh[i] = 0; psc[i] = 0; ps[i] = 0;
                  }
          }
-         for ( r0 = 0; x; x = NEXT(x) ) {
+         for ( r0 = 0, ind0 = 0; x; x = NEXT(x) ) {
                  NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
-                 dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+                 if ( input_is_dp )
+                         BDY(r) = (pointer)ps[(int)BDY(x)];
+                 else
+                         dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+                 NEXTNODE(ind0,ind);
+                 STOQ((int)BDY(x),q); BDY(ind) = q;
          }
          if ( r0 ) NEXT(r) = 0;
+         if ( ind0 ) NEXT(ind) = 0;
          MKLIST(*rp,r0);
+         MKLIST(gbindex,ind0);
+         if ( GenTrace && OXCheck < 0 ) {
+                 x = AllTraceList;
+                 for ( r = 0; x; x = NEXT(x) ) {
+                         MKNODE(r0,BDY(x),r); r = r0;
+                 }
+                 MKLIST(trace,r);
+                 r0 = mknode(3,*rp,gbindex,trace);
+                 MKLIST(*rp,r0);
+         }
          print_stat();
          if ( ShowMag )
-                 fprintf(asir_out,"\nMax_mag=%d\n",Max_mag);
+                 fprintf(asir_out,"\nMax_mag=%d, Max_coef=%d\n",Max_mag, Max_coef);
  }
- void dp_gr_mod_main(f,v,homo,m,ord,rp)
+ void dp_interreduce(LIST f,LIST v,int field,struct order_spec *ord,LIST *rp)
- LIST f,v;
- Num homo;
- int m;
- struct order_spec *ord;
- LIST *rp;
  {
-         struct order_spec ord1;
+         int i,mindex,m,nochk;
+         struct order_spec *ord1;
+         Q q;
          VL fv,vv,vc;
+         NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
+         NODE ind,ind0;
+         LIST trace,gbindex;
+         int input_is_dp = 0;
+         mindex = 0; nochk = 0; dp_fcoeffs = field;
+         get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
+         NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
+         CNVars = NVars;
+         if ( ord->id && NVars != ord->nv )
+                 error("dp_interreduce : invalid order specification");
+         initd(ord);
+         for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+                 NEXTNODE(fd0,fd);
+                 if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+                         dp_sort((DP)BDY(t),(DP *)&BDY(fd)); input_is_dp = 1;
+                 } else
+                         ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
+         }
+         if ( fd0 ) NEXT(fd) = 0;
+         fi0 = fd0;
+         setup_arrays(fd0,0,&s);
+         init_stat();
+         x = s;
+         reduceall(x,&xx); x = xx;
+         for ( r0 = 0, ind0 = 0; x; x = NEXT(x) ) {
+                 NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
+                 if ( input_is_dp )
+                         BDY(r) = (pointer)ps[(int)BDY(x)];
+                 else
+                         dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+                 NEXTNODE(ind0,ind);
+                 STOQ((int)BDY(x),q); BDY(ind) = q;
+         }
+         if ( r0 ) NEXT(r) = 0;
+         if ( ind0 ) NEXT(ind) = 0;
+         MKLIST(*rp,r0);
+         MKLIST(gbindex,ind0);
+ }
+ void dp_gr_mod_main(LIST f,LIST v,Num homo,int m,struct order_spec *ord,LIST *rp)
+ {
+         struct order_spec *ord1;
+         VL fv,vv,vc;
          NODE fd,fd0,r,r0,t,x,s,xx;
          DP a,b,c;
+         extern struct oEGT eg_red_mod;
+         int input_is_dp = 0;
          get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
          NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
-Line 422  LIST *rp;
+Line 473  LIST *rp;
 Line 422  LIST *rp;
 Line 473  LIST *rp;
          initd(ord);
          if ( homo ) {
                  for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
-                         ptod(CO,vv,(P)BDY(t),&a); dp_homo(a,&b);
+                         if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+                                 dp_sort((DP)BDY(t),&a); input_is_dp = 1;
+                         } else
+                                 ptod(CO,vv,(P)BDY(t),&a);
+                         dp_homo(a,&b);
                          if ( PCoeffs )
                                  dp_mod(b,m,0,&c);
                          else
-Line 431  LIST *rp;
+Line 486  LIST *rp;
 Line 431  LIST *rp;
 Line 486  LIST *rp;
                                  NEXTNODE(fd0,fd); BDY(fd) = (pointer)c;
                          }
                  }
-                 homogenize_order(ord,NVars,&ord1); initd(&ord1);
+                 homogenize_order(ord,NVars,&ord1); initd(ord1);
          } else {
                  for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
-                         ptod(CO,vv,(P)BDY(t),&b);
+                         if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+                                 dp_sort((DP)BDY(t),&b); input_is_dp = 1;
+                         } else
+                                 ptod(CO,vv,(P)BDY(t),&b);
                          if ( PCoeffs )
                                  dp_mod(b,m,0,&c);
                          else
-Line 448  LIST *rp;
+Line 506  LIST *rp;
 Line 448  LIST *rp;
 Line 506  LIST *rp;
          setup_arrays(fd0,m,&s);
          init_stat();
          if ( homo ) {
-                 initd(&ord1); CNVars = NVars+1;
+                 initd(ord1); CNVars = NVars+1;
          }
+ /* init_eg(&eg_red_mod); */
          x = gb_mod(s,m);
+ /* print_eg("Red_mod",&eg_red_mod); */
          if ( homo ) {
                  reducebase_dehomo(x,&xx); x = xx;
                  initd(ord); CNVars = NVars;
-Line 458  LIST *rp;
+Line 518  LIST *rp;
 Line 458  LIST *rp;
 Line 518  LIST *rp;
          reduceall_mod(x,m,&xx); x = xx;
          if ( PCoeffs )
                  for ( r0 = 0; x; x = NEXT(x) ) {
-                         NEXTNODE(r0,r); mdtop(CO,m,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+                         NEXTNODE(r0,r);
+                         if ( input_is_dp )
+                                 mdtodp(ps[(int)BDY(x)],(DP *)&BDY(r));
+                         else
+                                 mdtop(CO,m,vv,ps[(int)BDY(x)],(P *)&BDY(r));
                  }
          else
                  for ( r0 = 0; x; x = NEXT(x) ) {
-                         NEXTNODE(r0,r); _dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+                         NEXTNODE(r0,r);
+                         if ( input_is_dp )
+                                 _mdtodp(ps[(int)BDY(x)],(DP *)&BDY(r));
+                         else
+                                 _dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
                  }
          print_stat();
          if ( r0 ) NEXT(r) = 0;
          MKLIST(*rp,r0);
  }
- void dp_f4_main(f,v,ord,rp)
+ void dp_f4_main(LIST f,LIST v,struct order_spec *ord,LIST *rp)
- LIST f,v;
- struct order_spec *ord;
- LIST *rp;
  {
-         int i,mindex,m,nochk;
+         int homogen;
-         struct order_spec ord1;
          VL fv,vv,vc;
-         NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
+         NODE fd,fd0,r,r0,t,x,s,xx;
+         int input_is_dp = 0;
          dp_fcoeffs = 0;
          get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
-Line 486  LIST *rp;
+Line 551  LIST *rp;
 Line 486  LIST *rp;
 Line 551  LIST *rp;
          if ( ord->id && NVars != ord->nv )
                  error("dp_f4_main : invalid order specification");
          initd(ord);
-         for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+         for ( fd0 = 0, t = BDY(f), homogen = 1; t; t = NEXT(t) ) {
-                 NEXTNODE(fd0,fd); ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
+                 NEXTNODE(fd0,fd);
+                 if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+                         dp_sort((DP)BDY(t),(DP *)&BDY(fd)); input_is_dp = 1;
+                 } else
+                         ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
+                 if ( homogen )
+                         homogen = dp_homogeneous(BDY(fd));
          }
          if ( fd0 ) NEXT(fd) = 0;
          setup_arrays(fd0,0,&s);
          x = gb_f4(s);
-         reduceall(x,&xx); x = xx;
+         if ( !homogen ) {
+                 reduceall(x,&xx); x = xx;
+         }
          for ( r0 = 0; x; x = NEXT(x) ) {
                  NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
-                 dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+                 if ( input_is_dp )
+                         BDY(r) = (pointer)ps[(int)BDY(x)];
+                 else
+                         dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
          }
          if ( r0 ) NEXT(r) = 0;
          MKLIST(*rp,r0);
  }
- void dp_f4_mod_main(f,v,m,ord,rp)
+ void dp_f4_mod_main(LIST f,LIST v,int m,struct order_spec *ord,LIST *rp)
- LIST f,v;
- int m;
- struct order_spec *ord;
- LIST *rp;
  {
-         int i;
+         int homogen;
-         struct order_spec ord1;
          VL fv,vv,vc;
-         DP b,c;
+         DP b,c,c1;
-         NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
+         NODE fd,fd0,r,r0,t,x,s,xx;
+         int input_is_dp = 0;
          dp_fcoeffs = 0;
          get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
-Line 520  LIST *rp;
+Line 592  LIST *rp;
 Line 520  LIST *rp;
 Line 592  LIST *rp;
          if ( ord->id && NVars != ord->nv )
                  error("dp_f4_mod_main : invalid order specification");
          initd(ord);
-         for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+         for ( fd0 = 0, t = BDY(f), homogen = 1; t; t = NEXT(t) ) {
-                 ptod(CO,vv,(P)BDY(t),&b);
+                 if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+                         dp_sort((DP)BDY(t),&b); input_is_dp = 1;
+                 } else
+                         ptod(CO,vv,(P)BDY(t),&b);
+                 if ( homogen )
+                         homogen = dp_homogeneous(b);
                  _dp_mod(b,m,0,&c);
+                 _dp_monic(c,m,&c1);
                  if ( c ) {
-                         NEXTNODE(fd0,fd); BDY(fd) = (pointer)c;
+                         NEXTNODE(fd0,fd); BDY(fd) = (pointer)c1;
                  }
          }
          if ( fd0 ) NEXT(fd) = 0;
          setup_arrays(fd0,m,&s);
-         x = gb_f4_mod(s,m);
+         init_stat();
-         reduceall_mod(x,m,&xx); x = xx;
+         if ( do_weyl )
+                 x = gb_f4_mod_old(s,m);
+         else
+                 x = gb_f4_mod(s,m);
+         if ( !homogen ) {
+                 reduceall_mod(x,m,&xx); x = xx;
+         }
          for ( r0 = 0; x; x = NEXT(x) ) {
-                 NEXTNODE(r0,r); _dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+                 NEXTNODE(r0,r);
+                 if ( input_is_dp )
+                         _mdtodp(ps[(int)BDY(x)],(DP *)&BDY(r));
+                 else
+                         _dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
          }
          if ( r0 ) NEXT(r) = 0;
          MKLIST(*rp,r0);
+         print_stat();
  }
- NODE gb_f4(f)
+ NODE gb_f4(NODE f)
- NODE f;
  {
-         int i,j,k,nh,row,col,nv;
+         int i,k,nh,row,col,nv;
          NODE r,g,gall;
          NODE s,s0;
          DP_pairs d,dm,dr,t;
-         DP h,nf,nf1,f1,f2,f21,f21r,sp,sp1,sd,sdm,tdp;
+         DP nf,nf1,f2,sp,sd,tdp;
          MP mp,mp0;
-         NODE blist,bt,nt;
+         NODE blist,bt;
          DL *ht,*at;
          MAT mat,nm;
-         int *colstat;
          int *rind,*cind;
          int rank,nred;
          Q dn;
-         struct oEGT tmp0,tmp1,tmp2,eg_split_symb,eg_split_elim;
+         struct oEGT tmp0,tmp1,eg_split_symb;
          extern struct oEGT eg_mod,eg_elim,eg_chrem,eg_gschk,eg_intrat,eg_symb;
          init_eg(&eg_mod); init_eg(&eg_elim); init_eg(&eg_chrem);
-Line 572  NODE f;
+Line 659  NODE f;
 Line 572  NODE f;
 Line 659  NODE f;
          while ( d ) {
                  get_eg(&tmp0);
                  minsugar(d,&dm,&dr); d = dr;
-                 if ( Print )
+                 if ( DP_Print )
                          fprintf(asir_out,"sugar=%d\n",dm->sugar);
                  blist = 0; s0 = 0;
                  /* asph : sum of all head terms of spoly */
-Line 613  NODE f;
+Line 700  NODE f;
 Line 613  NODE f;
 Line 700  NODE f;
                          dp_to_vect(BDY(r),at,(Q *)mat->body[i]);
                  get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);
                  init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);
-                 if ( Print ) {
+                 if ( DP_Print ) {
                          print_eg("Symb",&eg_split_symb);
                          fprintf(asir_out,"mat : %d x %d",row,col);
                          fflush(asir_out);
                  }
+ #if 0
+                 rank = generic_gauss_elim_hensel(mat,&nm,&dn,&rind,&cind);
+ #else
                  rank = generic_gauss_elim(mat,&nm,&dn,&rind,&cind);
-                 if ( Print )
+ #endif
+                 if ( DP_Print )
                          fprintf(asir_out,"done rank = %d\n",rank,row,col);
                  for ( i = 0; i < rank; i++ ) {
                          for ( k = 0; k < nred; k++ )
-Line 644  NODE f;
+Line 735  NODE f;
 Line 644  NODE f;
 Line 735  NODE f;
                          }
                  }
          }
-         if ( Print ) {
+         if ( DP_Print ) {
                  print_eg("Symb",&eg_symb);
                  print_eg("Mod",&eg_mod); print_eg("GaussElim",&eg_elim);
                  print_eg("ChRem",&eg_chrem); print_eg("IntToRat",&eg_intrat);
-Line 653  NODE f;
+Line 744  NODE f;
 Line 653  NODE f;
 Line 744  NODE f;
          return g;
  }
- NODE gb_f4_mod(f,m)
+ /* initial bases are monic */
- NODE f;
- int m;
+ unsigned int **psca;
+ GeoBucket create_bucket();
+ DL remove_head_bucket(GeoBucket,int);
+ NODE gb_f4_mod(NODE f,int m)
  {
          int i,j,k,nh,row,col,nv;
          NODE r,g,gall;
          NODE s,s0;
          DP_pairs d,dm,dr,t;
-         DP h,nf,f1,f2,f21,f21r,sp,sp1,sd,sdm,tdp;
+         DP nf,sp,sd,tdp;
          MP mp,mp0;
-         NODE blist,bt,nt;
+         NODE blist,bt,bt1,dt;
-         DL *ht,*at;
+         DL *at,*st;
-         int **mat;
+         int **spmat;
-         int *colstat;
+         CDP *redmat;
-         int rank,nred,nonzero;
+         int *colstat,*w,*w1;
-         struct oEGT tmp0,tmp1,tmp2,eg_split_symb,eg_split_elim;
+         int rank,nred,nsp,nsp0,nonzero,spcol;
-         extern struct oEGT eg_symb,eg_elim;
+         int *indred,*isred;
+         CDP ri;
+         int pscalen;
+         GeoBucket bucket;
+         DL head;
+         struct oEGT tmp0,tmp1,eg_split_symb,eg_split_conv,eg_split_elim1,eg_split_elim2;
+         extern struct oEGT eg_symb,eg_conv,eg_elim1,eg_elim2;
-         init_eg(&eg_symb); init_eg(&eg_elim);
+         /* initialize coeffcient array list of ps[] */
+         pscalen = pslen;
+         psca = (unsigned int **)MALLOC(pscalen*sizeof(unsigned int *));
+         init_eg(&eg_symb); init_eg(&eg_conv); init_eg(&eg_elim1); init_eg(&eg_elim2);
          for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
                  i = (int)BDY(r);
                  d = updpairs(d,g,i);
                  g = updbase(g,i);
                  gall = append_one(gall,i);
+                 dptoca(ps[i],&psca[i]);
          }
          if ( gall )
                  nv = ((DP)ps[(int)BDY(gall)])->nv;
          while ( d ) {
                  get_eg(&tmp0);
                  minsugar(d,&dm,&dr); d = dr;
-                 if ( Print )
+                 if ( DP_Print )
                          fprintf(asir_out,"sugar=%d\n",dm->sugar);
+                 blist = 0;
+                 bucket = create_bucket();
+                 /* asph : sum of all head terms of spoly */
+                 for ( t = dm; t; t = NEXT(t) ) {
+                         _dp_sp_mod(ps[t->dp1],ps[t->dp2],m,&sp);
+ /*                      fprintf(stderr,"splen=%d-",dp_nt(sp)); */
+                         if ( sp ) {
+                                 MKNODE(bt,sp,blist); blist = bt;
+                                 add_bucket(bucket,dp_dllist(sp),nv);
+ /*                              fprintf(stderr,"%d-",length(s0)); */
+                         }
+                 }
+ #if 0
+                 if ( DP_Print )
+                         fprintf(asir_out,"initial spmat : %d x %d ",length(blist),length(s0));
+ #endif
+                 /* s0 : all the terms appeared in symbolic reduction */
+                 nred = 0;
+                 s0 = 0;
+                 while ( 1 ) {
+                         head = remove_head_bucket(bucket,nv);
+                         if ( !head ) break;
+                         else {
+                                 NEXTNODE(s0,s);
+                                 BDY(s) = (pointer)head;
+                         }
+                         for ( r = gall; r; r = NEXT(r) )
+                                 if ( _dl_redble(BDY(ps[(int)BDY(r)])->dl,head,nv) )
+                                         break;
+                         if ( r ) {
+                                 dltod(head,nv,&tdp);
+                                 dp_subd(tdp,ps[(int)BDY(r)],&sd);
+                                 dt = mul_dllist(BDY(sd)->dl,ps[(int)BDY(r)]);
+                                 add_bucket(bucket,NEXT(dt),nv);
+ /*                              fprintf(stderr,"[%d]",length(dt)); */
+                                 /* list of [t,f] */
+                                 bt1 = mknode(2,BDY(sd)->dl,BDY(r));
+                                 MKNODE(bt,bt1,blist); blist = bt;
+ /*                              fprintf(stderr,"%d-",length(s0));  */
+                                 nred++;
+                         }
+                 }
+                 if ( s0 ) NEXT(s) = 0;
+ /*              fprintf(stderr,"\n"); */
+                 get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);
+                 init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);
+                 if ( DP_Print )
+                         fprintf(asir_out,"number of reducers : %d\n",nred);
+                 get_eg(&tmp0);
+                 /* the first nred polys in blist are reducers */
+                 /* row = the number of all the polys */
+                 for ( r = blist, row = 0; r; r = NEXT(r), row++ );
+                 /* col = number of all terms */
+                 for ( s = s0, col = 0; s; s = NEXT(s), col++ );
+                 /* head terms of all terms */
+                 at = (DL *)MALLOC(col*sizeof(DL));
+                 for ( s = s0, i = 0; i < col; s = NEXT(s), i++ )
+                         at[i] = (DL)BDY(s);
+                 /* store coefficients separately in spmat and redmat */
+                 nsp = row-nred;
+                 /* reducer matrix */
+                 /* indred : register the position of the head term */
+                 redmat = (CDP *)MALLOC(nred*sizeof(CDP));
+                 for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ )
+                         _tf_to_vect_compress(BDY(r),at,&redmat[i]);
+                 /* register the position of the head term */
+                 indred = (int *)MALLOC_ATOMIC(nred*sizeof(int));
+                 bzero(indred,nred*sizeof(int));
+                 isred = (int *)MALLOC_ATOMIC(col*sizeof(int));
+                 bzero(isred,col*sizeof(int));
+                 for ( i = 0; i < nred; i++ ) {
+                         ri = redmat[i];
+                         indred[i] = ri->body[0];
+                         isred[indred[i]] = 1;
+                 }
+                 spcol = col-nred;
+                 /* head terms not in ht */
+                 st = (DL *)MALLOC(spcol*sizeof(DL));
+                 for ( j = 0, k = 0; j < col; j++ )
+                         if ( !isred[j] )
+                                 st[k++] = at[j];
+                 get_eg(&tmp1); add_eg(&eg_conv,&tmp0,&tmp1);
+                 init_eg(&eg_split_conv); add_eg(&eg_split_conv,&tmp0,&tmp1);
+                 get_eg(&tmp1);
+                 /* spoly matrix; stored in reduced form; terms in ht[] are omitted */
+                 spmat = (int **)MALLOC(nsp*sizeof(int *));
+                 w = (int *)MALLOC_ATOMIC(col*sizeof(int));
+                 /* skip reducers in blist */
+                 for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ );
+                 for ( i = 0; r; r = NEXT(r) ) {
+                         bzero(w,col*sizeof(int));
+                         _dpmod_to_vect(BDY(r),at,w);
+                         reduce_sp_by_red_mod_compress(w,redmat,indred,nred,col,m);
+                         for ( j = 0; j < col; j++ )
+                                 if ( w[j] )
+                                         break;
+                         if ( j < col ) {
+                                 w1 = (int *)MALLOC_ATOMIC(spcol*sizeof(int));
+                                 for ( j = 0, k = 0; j < col; j++ )
+                                         if ( !isred[j] )
+                                                 w1[k++] = w[j];
+                                 spmat[i] = w1;
+                                 i++;
+                         }
+                 }
+                 /* update nsp */
+                 nsp0 = nsp;
+                 nsp = i;
+                 /* XXX free redmat explicitly */
+                 for ( k = 0; k < nred; k++ ) {
+                         GCFREE(BDY(redmat[k]));
+                         GCFREE(redmat[k]);
+                 }
+                 get_eg(&tmp0); add_eg(&eg_elim1,&tmp1,&tmp0);
+                 init_eg(&eg_split_elim1); add_eg(&eg_split_elim1,&tmp1,&tmp0);
+                 colstat = (int *)MALLOC_ATOMIC(spcol*sizeof(int));
+                 bzero(colstat,spcol*sizeof(int));
+                 for ( i = 0, nonzero=0; i < nsp; i++ )
+                         for ( j = 0; j < spcol; j++ )
+                                 if ( spmat[i][j] )
+                                         nonzero++;
+                 if ( DP_Print && nsp )
+                         fprintf(asir_out,"spmat : %d x %d (nonzero=%f%%)...",
+                                 nsp,spcol,((double)nonzero*100)/(nsp*spcol));
+                 if ( nsp )
+                         rank = generic_gauss_elim_mod(spmat,nsp,spcol,m,colstat);
+                 else
+                         rank = 0;
+                 get_eg(&tmp1); add_eg(&eg_elim2,&tmp0,&tmp1);
+                 init_eg(&eg_split_elim2); add_eg(&eg_split_elim2,&tmp0,&tmp1);
+                 if ( DP_Print ) {
+                         fprintf(asir_out,"done rank = %d\n",rank,row,col);
+                         print_eg("Symb",&eg_split_symb);
+                         print_eg("Conv",&eg_split_conv);
+                         print_eg("Elim1",&eg_split_elim1);
+                         print_eg("Elim2",&eg_split_elim2);
+                         fprintf(asir_out,"\n");
+                 }
+                 NZR += rank;
+                 ZR += nsp0-rank;
+                 if ( !rank )
+                         continue;
+                 for ( j = 0, i = 0; j < spcol; j++ )
+                         if ( colstat[j] ) {
+                                 mp0 = 0;
+                                 NEXTMP(mp0,mp); mp->dl = st[j]; mp->c = STOI(1);
+                                 for ( k = j+1; k < spcol; k++ )
+                                         if ( !colstat[k] && spmat[i][k] ) {
+                                                 NEXTMP(mp0,mp); mp->dl = st[k];
+                                                 mp->c = STOI(spmat[i][k]);
+                                 }
+                                 NEXT(mp) = 0;
+                                 MKDP(nv,mp0,nf); nf->sugar = dm->sugar;
+                                 nh = newps_mod(nf,m);
+                                 if ( nh == pscalen ) {
+                                         psca = (unsigned int **)
+                                                 REALLOC(psca,2*pscalen*sizeof(unsigned int *));
+                                         pscalen *= 2;
+                                 }
+                                 dptoca(ps[nh],&psca[nh]);
+                                 d = updpairs(d,g,nh);
+                                 g = updbase(g,nh);
+                                 gall = append_one(gall,nh);
+                                 i++;
+                         }
+                 /* XXX free spmat[] explicitly */
+                 for ( j = 0; j < nsp; j++ ) {
+                         GCFREE(spmat[j]);
+                 }
+         }
+         if ( DP_Print ) {
+                 print_eg("Symb",&eg_symb);
+                 print_eg("Conv",&eg_conv);
+                 print_eg("Elim1",&eg_elim1);
+                 print_eg("Elim2",&eg_elim2);
+                 fflush(asir_out);
+         }
+         return g;
+ }
+ NODE gb_f4_mod_old(NODE f,int m)
+ {
+         int i,j,k,nh,row,col,nv;
+         NODE r,g,gall;
+         NODE s,s0;
+         DP_pairs d,dm,dr,t;
+         DP nf,f2,sp,sd,sdm,tdp;
+         MP mp,mp0;
+         NODE blist,bt;
+         DL *ht,*at,*st;
+         int **spmat,**redmat;
+         int *colstat,*w;
+         int rank,nred,nsp,nonzero,spcol;
+         int *indred,*isred,*ri;
+         struct oEGT tmp0,tmp1,eg_split_symb,eg_split_elim1,eg_split_elim2;
+         extern struct oEGT eg_symb,eg_elim1,eg_elim2;
+         init_eg(&eg_symb); init_eg(&eg_elim1); init_eg(&eg_elim2);
+         for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
+                 i = (int)BDY(r);
+                 d = updpairs(d,g,i);
+                 g = updbase(g,i);
+                 gall = append_one(gall,i);
+         }
+         if ( gall )
+                 nv = ((DP)ps[(int)BDY(gall)])->nv;
+         while ( d ) {
+                 get_eg(&tmp0);
+                 minsugar(d,&dm,&dr); d = dr;
+                 if ( DP_Print )
+                         fprintf(asir_out,"sugar=%d\n",dm->sugar);
                  blist = 0; s0 = 0;
                  /* asph : sum of all head terms of spoly */
                  for ( t = dm; t; t = NEXT(t) ) {
-Line 703  int m;
+Line 1038  int m;
 Line 703  int m;
 Line 1038  int m;
                                  dltod(BDY(s),nv,&tdp);
                                  dp_subd(tdp,ps[(int)BDY(r)],&sd);
                                  _dp_mod(sd,m,0,&sdm);
-                                 _mulmd(CO,m,sdm,ps[(int)BDY(r)],&f2);
+                                 mulmd_dup(m,sdm,ps[(int)BDY(r)],&f2);
                                  MKNODE(bt,f2,blist); blist = bt;
                                  s = symb_merge(s,dp_dllist(f2),nv);
                                  nred++;
                          }
                  }
+                 get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);
+                 init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);
                  /* the first nred polys in blist are reducers */
                  /* row = the number of all the polys */
                  for ( r = blist, row = 0; r; r = NEXT(r), row++ );
+                 /* head terms of reducers */
                  ht = (DL *)MALLOC(nred*sizeof(DL));
                  for ( r = blist, i = 0; i < nred; r = NEXT(r), i++ )
                          ht[i] = BDY((DP)BDY(r))->dl;
+                 /* col = number of all terms */
                  for ( s = s0, col = 0; s; s = NEXT(s), col++ );
+                 /* head terms of all terms */
                  at = (DL *)MALLOC(col*sizeof(DL));
                  for ( s = s0, i = 0; i < col; s = NEXT(s), i++ )
                          at[i] = (DL)BDY(s);
-                 mat = almat(row,col);
-                 for ( i = 0, r = blist; i < row; r = NEXT(r), i++ )
+                 /* store coefficients separately in spmat and redmat */
-                         _dpmod_to_vect(BDY(r),at,mat[i]);
+                 nsp = row-nred;
-                 colstat = (int *)MALLOC_ATOMIC(col*sizeof(int));
-                 for ( i = 0, nonzero=0; i < row; i++ )
+                 /* reducer matrix */
-                         for ( j = 0; j < col; j++ )
+                 redmat = (int **)almat(nred,col);
-                                 if ( mat[i][j] )
+                 for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ )
+                         _dpmod_to_vect(BDY(r),at,redmat[i]);
+                 /* XXX */
+ /*              reduce_reducers_mod(redmat,nred,col,m); */
+                 /* register the position of the head term */
+                 indred = (int *)MALLOC(nred*sizeof(int));
+                 bzero(indred,nred*sizeof(int));
+                 isred = (int *)MALLOC(col*sizeof(int));
+                 bzero(isred,col*sizeof(int));
+                 for ( i = 0; i < nred; i++ ) {
+                         ri = redmat[i];
+                         for ( j = 0; j < col && !ri[j]; j++ );
+                         indred[i] = j;
+                         isred[j] = 1;
+                 }
+                 spcol = col-nred;
+                 /* head terms not in ht */
+                 st = (DL *)MALLOC(spcol*sizeof(DL));
+                 for ( j = 0, k = 0; j < col; j++ )
+                         if ( !isred[j] )
+                                 st[k++] = at[j];
+                 /* spoly matrix; stored in reduced form; terms in ht[] are omitted */
+                 spmat = almat(nsp,spcol);
+                 w = (int *)MALLOC(col*sizeof(int));
+                 for ( ; i < row; r = NEXT(r), i++ ) {
+                         bzero(w,col*sizeof(int));
+                         _dpmod_to_vect(BDY(r),at,w);
+                         reduce_sp_by_red_mod(w,redmat,indred,nred,col,m);
+                         for ( j = 0, k = 0; j < col; j++ )
+                                 if ( !isred[j] )
+                                         spmat[i-nred][k++] = w[j];
+                 }
+                 get_eg(&tmp0); add_eg(&eg_elim1,&tmp1,&tmp0);
+                 init_eg(&eg_split_elim1); add_eg(&eg_split_elim1,&tmp1,&tmp0);
+                 colstat = (int *)MALLOC_ATOMIC(spcol*sizeof(int));
+                 for ( i = 0, nonzero=0; i < nsp; i++ )
+                         for ( j = 0; j < spcol; j++ )
+                                 if ( spmat[i][j] )
                                          nonzero++;
-                 if ( Print )
+                 if ( DP_Print && nsp )
-                         fprintf(asir_out,"mat : %d x %d (nonzero=%f%%)...",
+                         fprintf(asir_out,"spmat : %d x %d (nonzero=%f%%)...",
-                                 row,col,((double)nonzero*100)/(row*col));
+                                 nsp,spcol,((double)nonzero*100)/(nsp*spcol));
-                 get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);
+                 if ( nsp )
-                 init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);
+                         rank = generic_gauss_elim_mod(spmat,nsp,spcol,m,colstat);
-                 rank = generic_gauss_elim_mod(mat,row,col,m,colstat);
+                 else
-                 get_eg(&tmp2); add_eg(&eg_elim,&tmp1,&tmp2);
+                         rank = 0;
-                 init_eg(&eg_split_elim); add_eg(&eg_split_elim,&tmp1,&tmp2);
+                 get_eg(&tmp1); add_eg(&eg_elim2,&tmp0,&tmp1);
-                 if ( Print ) {
+                 init_eg(&eg_split_elim2); add_eg(&eg_split_elim2,&tmp0,&tmp1);
+                 if ( DP_Print ) {
                          fprintf(asir_out,"done rank = %d\n",rank,row,col);
                          print_eg("Symb",&eg_split_symb);
-                         print_eg("Elim",&eg_split_elim);
+                         print_eg("Elim1",&eg_split_elim1);
+                         print_eg("Elim2",&eg_split_elim2);
                          fprintf(asir_out,"\n");
                  }
-                 for ( j = 0, i = 0; j < col; j++ )
+                 for ( j = 0, i = 0; j < spcol; j++ )
                          if ( colstat[j] ) {
-                                 for ( k = 0; k < nred; k++ )
+                                 mp0 = 0;
-                                         if ( !cmpdl(nv,at[j],ht[k]) )
+                                 NEXTMP(mp0,mp); mp->dl = st[j]; mp->c = STOI(1);
-                                                 break;
+                                 for ( k = j+1; k < spcol; k++ )
-                                 if ( k == nred ) {
+                                         if ( !colstat[k] && spmat[i][k] ) {
-                                         /* this is a new base */
+                                                 NEXTMP(mp0,mp); mp->dl = st[k];
-                                         mp0 = 0;
+                                                 mp->c = STOI(spmat[i][k]);
-                                         NEXTMP(mp0,mp); mp->dl = at[j]; mp->c = STOI(1);
-                                         for ( k = j+1; k < col; k++ )
-                                                 if ( !colstat[k] && mat[i][k] ) {
-                                                         NEXTMP(mp0,mp); mp->dl = at[k];
-                                                         mp->c = STOI(mat[i][k]);
-                                                 }
-                                         NEXT(mp) = 0;
-                                         MKDP(nv,mp0,nf); nf->sugar = dm->sugar;
-                                         nh = newps_mod(nf,m);
-                                         d = updpairs(d,g,nh);
-                                         g = updbase(g,nh);
-                                         gall = append_one(gall,nh);
                                  }
+                                 NEXT(mp) = 0;
+                                 MKDP(nv,mp0,nf); nf->sugar = dm->sugar;
+                                 nh = newps_mod(nf,m);
+                                 d = updpairs(d,g,nh);
+                                 g = updbase(g,nh);
+                                 gall = append_one(gall,nh);
                                  i++;
                          }
          }
-         if ( Print ) {
+         if ( DP_Print ) {
                  print_eg("Symb",&eg_symb);
-                 print_eg("Elim",&eg_elim);
+                 print_eg("Elim1",&eg_elim1);
+                 print_eg("Elim2",&eg_elim2);
                  fflush(asir_out);
          }
          return g;
  }
- int DPPlength(n)
+ int DPPlength(DP_pairs n)
- DP_pairs n;
  {
          int i;
-Line 783  DP_pairs n;
+Line 1165  DP_pairs n;
 Line 783  DP_pairs n;
 Line 1165  DP_pairs n;
          return i;
  }
- void printdl(dl)
+ void printdl(DL dl)
- DL dl;
  {
          int i;
-Line 794  DL dl;
+Line 1175  DL dl;
 Line 794  DL dl;
 Line 1175  DL dl;
          fprintf(asir_out,"%d>>",dl->d[i]);
  }
- void pltovl(l,vl)
+ void pltovl(LIST l,VL *vl)
- LIST l;
- VL *vl;
  {
          NODE n;
          VL r,r0;
-Line 809  VL *vl;
+Line 1188  VL *vl;
 Line 809  VL *vl;
 Line 1188  VL *vl;
          *vl = r0;
  }
- void makesubst(v,s)
+ void vltopl(VL vl,LIST *l)
- VL v;
- NODE *s;
  {
+         VL n;
          NODE r,r0;
+         P p;
+         n = vl;
+         for ( r0 = 0; n; n = NEXT(n) ) {
+                 NEXTNODE(r0,r); MKV(n->v,p); BDY(r) = (pointer)p;
+         }
+         if ( r0 ) NEXT(r) = 0;
+         MKLIST(*l,r0);
+ }
+ void makesubst(VL v,NODE *s)
+ {
+         NODE r,r0;
          Q q;
          unsigned int n;
-Line 830  NODE *s;
+Line 1221  NODE *s;
 Line 830  NODE *s;
 Line 1221  NODE *s;
          *s = r0;
  }
- void printsubst(s)
+ void printsubst(NODE s)
- NODE s;
  {
          fputc('[',asir_out);
          while ( s ) {
-Line 845  NODE s;
+Line 1235  NODE s;
 Line 845  NODE s;
 Line 1235  NODE s;
          fprintf(asir_out,"]\n"); return;
  }
- void vlminus(v,w,d)
+ void vlminus(VL v,VL w,VL *d)
- VL v,w,*d;
  {
          int i,j,n,m;
          V *va,*wa;
-Line 876  VL v,w,*d;
+Line 1265  VL v,w,*d;
 Line 876  VL v,w,*d;
 Line 1265  VL v,w,*d;
          *d = r0;
  }
- int validhc(a,m,s)
+ int validhc(P a,int m,NODE s)
- P a;
- int m;
- NODE s;
  {
          P c,c1;
          V v;
-Line 894  NODE s;
+Line 1280  NODE s;
 Line 894  NODE s;
 Line 1280  NODE s;
          return c1 ? 1 : 0;
  }
- void setup_arrays(f,m,r)
+ void setup_arrays(NODE f,int m,NODE *r)
- NODE f,*r;
- int m;
  {
          int i;
-         NODE s,s0;
+         NODE s,s0,f0;
-         f = NODE_sortb(f,1);
+ #if 1
+         f0 = f = NODE_sortb(f,1);
+ #else
+         f0 = f;
+ #endif
          psn = length(f); pslen = 2*psn;
          ps = (DP *)MALLOC(pslen*sizeof(DP));
          psh = (DL *)MALLOC(pslen*sizeof(DL));
-Line 910  int m;
+Line 1298  int m;
 Line 910  int m;
 Line 1298  int m;
          for ( i = 0; i < psn; i++, f = NEXT(f) ) {
                  prim_part((DP)BDY(f),m,&ps[i]);
                  if ( Demand )
-                         dp_save(i,ps[i]);
+                         dp_save(i,(Obj)ps[i],0);
                  psh[i] = BDY(ps[i])->dl;
                  pss[i] = ps[i]->sugar;
                  psc[i] = BDY(ps[i])->c;
          }
+         if ( GenTrace ) {
+                 Q q;
+                 STRING fname;
+                 LIST input;
+                 NODE arg,t,t1;
+                 Obj obj;
+                 t = 0;
+                 for ( i = psn-1; i >= 0; i-- ) {
+                         MKNODE(t1,ps[i],t);
+                         t = t1;
+                 }
+                 MKLIST(input,t);
+                 if ( OXCheck >= 0 ) {
+                         STOQ(OXCheck,q);
+                         MKSTR(fname,"register_input");
+                         arg = mknode(3,q,fname,input);
+                         Pox_cmo_rpc(arg,&obj);
+                 } else if ( OXCheck < 0 ) {
+                         MKNODE(AllTraceList,input,0);
+                 }
+         }
          for ( s0 = 0, i = 0; i < psn; i++ ) {
                  NEXTNODE(s0,s); BDY(s) = (pointer)i;
          }
-Line 922  int m;
+Line 1333  int m;
 Line 922  int m;
 Line 1333  int m;
          *r = s0;
  }
- void prim_part(f,m,r)
+ void prim_part(DP f,int m,DP *r)
- DP f,*r;
- int m;
  {
+         P d,t;
          if ( m > 0 ) {
                  if ( PCoeffs )
                          dp_prim_mod(f,m,r);
                  else
-                         *r = f;
+                         _dp_monic(f,m,r);
          } else {
-                 if ( dp_fcoeffs )
+                 if ( dp_fcoeffs || PCoeffs )
-                         *r = f;
-                 else if ( PCoeffs )
                          dp_prim(f,r);
                  else
                          dp_ptozp(f,r);
+                 if ( GenTrace && TraceList ) {
+                         /* adust the denominator according to the final
+                            content reduction */
+                         divsp(CO,BDY(f)->c,BDY(*r)->c,&d);
+                         mulp(CO,(P)ARG3(BDY((LIST)BDY(TraceList))),d,&t);
+                         ARG3(BDY((LIST)BDY(TraceList))) = t;
+                 }
          }
  }
- NODE /* of DP */ NODE_sortb_insert( newdp, nd, dec )
+ NODE /* of DP */ NODE_sortb_insert( DP newdp, NODE /* of DP */ nd, int dec )
- DP newdp;
- NODE /* of DP */ nd;
- int dec;
  {
          register NODE last, p;
          register DL newdl = BDY(newdp)->dl;
-Line 963  int dec;
+Line 1376  int dec;
 Line 963  int dec;
 Line 1376  int dec;
          return nd;
  }
- NODE NODE_sortb( node, dec )
+ NODE NODE_sortb( NODE node, int dec )
- NODE node;
- int dec;
  {
          register NODE nd, ans;
-Line 974  int dec;
+Line 1385  int dec;
 Line 974  int dec;
 Line 1385  int dec;
          return ans;
  }
- NODE /* of index */ NODE_sortbi_insert( newdpi, nd, dec )
+ NODE /* of index */ NODE_sortbi_insert( int newdpi, NODE /* of index */ nd, int dec )
- int newdpi;
- NODE /* of index */ nd;
- int dec;
  {
          register NODE last, p;
          register DL newdl = psh[newdpi];
-Line 996  int dec;
+Line 1404  int dec;
 Line 996  int dec;
 Line 1404  int dec;
          return nd;
  }
- NODE NODE_sortbi( node, dec )
+ NODE NODE_sortbi( NODE node, int dec )
- NODE node;
- int dec;
  {
          register NODE nd, ans;
-Line 1007  int dec;
+Line 1413  int dec;
 Line 1007  int dec;
 Line 1413  int dec;
          return ans;
  }
- void reduceall(in,h)
+ void reduceall(NODE in,NODE *h)
- NODE in;
- NODE *h;
  {
          NODE r,t,top;
          int n,i,j;
-Line 1020  NODE *h;
+Line 1424  NODE *h;
 Line 1020  NODE *h;
 Line 1424  NODE *h;
          if ( NoRA ) {
                  *h = in; return;
          }
-         if ( Print || PrintShort ) {
+         if ( DP_Print || DP_PrintShort ) {
                  fprintf(asir_out,"reduceall\n"); fflush(asir_out);
          }
          r = NODE_sortbi(in,0);
-Line 1028  NODE *h;
+Line 1432  NODE *h;
 Line 1028  NODE *h;
 Line 1432  NODE *h;
          w = (int *)ALLOCA(n*sizeof(int));
          for ( i = 0, t = r; i < n; i++, t = NEXT(t) )
                  w[i] = (int)BDY(t);
+         /* w[i] < 0 : reduced to 0 */
          for ( i = 0; i < n; i++ ) {
                  for ( top = 0, j = n-1; j >= 0; j-- )
-                         if ( j != i ) {
+                         if ( w[j] >= 0 && j != i ) {
                                  MKNODE(t,(pointer)w[j],top); top = t;
                          }
                  get_eg(&tmp0);
                  dp_load(w[i],&ps[w[i]]);
-                 _dp_nf(top,ps[w[i]],ps,1,&g);
-                 if ( !PtozpRA || !Multiple )
+                 if ( GenTrace ) {
-                         _dp_nf(top,ps[w[i]],ps,1,&g);
+                         Q q;
-                 else
+                         NODE node;
- #if MPI
+                         LIST hist;
-                         _dp_nf_ptozp_mpi(top,ps[w[i]],ps,1,Multiple,&g);
- #else
+                         STOQ(w[i],q);
-                         _dp_nf_ptozp(top,ps[w[i]],ps,1,Multiple,&g);
+                         node = mknode(4,ONE,q,ONE,ONE);
- #endif
+                         MKLIST(hist,node);
+                         MKNODE(TraceList,hist,0);
+                 }
+                 _dp_nf(top,ps[w[i]],ps,1,&g);
                  prim_part(g,0,&g1);
                  get_eg(&tmp1); add_eg(&eg_ra,&tmp0,&tmp1);
-                 if ( Print || PrintShort ) {
+                 if ( DP_Print || DP_PrintShort ) {
                          fprintf(asir_out,"."); fflush(asir_out);
                  }
-                 w[i] = newps(g1,0,(NODE)0);
+                 if ( g1 ) {
+                         w[i] = newps(g1,0,(NODE)0);
+                 } else {
+                         w[i] = -1;
+                 }
          }
          for ( top = 0, j = n-1; j >= 0; j-- ) {
-                 MKNODE(t,(pointer)w[j],top); top = t;
+                 if ( w[j] >= 0 ) {
+                         MKNODE(t,(pointer)w[j],top); top = t;
+                 }
          }
          *h = top;
-         if ( Print || PrintShort )
+         if ( DP_Print || DP_PrintShort )
                  fprintf(asir_out,"\n");
  }
- void reduceall_mod(in,m,h)
+ void reduceall_mod(NODE in,int m,NODE *h)
- NODE in;
- int m;
- NODE *h;
  {
          NODE r,t,top;
          int n,i,j;
          int *w;
-         DP g;
+         DP g,p;
          struct oEGT tmp0,tmp1;
          if ( NoRA ) {
                  *h = in; return;
          }
-         if ( Print || PrintShort ) {
+         if ( DP_Print || DP_PrintShort ) {
                  fprintf(asir_out,"reduceall\n"); fflush(asir_out);
          }
          r = NODE_sortbi(in,0);
-Line 1082  NODE *h;
+Line 1492  NODE *h;
 Line 1082  NODE *h;
 Line 1492  NODE *h;
          w = (int *)ALLOCA(n*sizeof(int));
          for ( i = 0, t = r; i < n; i++, t = NEXT(t) )
                  w[i] = (int)BDY(t);
+         /* w[i] < 0 : reduced to 0 */
          for ( i = 0; i < n; i++ ) {
                  for ( top = 0, j = n-1; j >= 0; j-- )
-                         if ( j != i ) {
+                         if ( w[j] >= 0 && j != i ) {
                                  MKNODE(t,(pointer)w[j],top); top = t;
                          }
                  get_eg(&tmp0);
                  if ( PCoeffs )
                          dp_nf_mod(top,ps[w[i]],ps,m,1,&g);
-                 else
+                 else {
-                         _dp_nf_mod(top,ps[w[i]],ps,m,1,&g);
+                         dpto_dp(ps[w[i]],&p);
+                         _dp_nf_mod_destructive(top,p,ps,m,1,&g);
+                 }
                  get_eg(&tmp1); add_eg(&eg_ra,&tmp0,&tmp1);
-                 if ( Print || PrintShort ) {
+                 if ( DP_Print || DP_PrintShort ) {
                          fprintf(asir_out,"."); fflush(asir_out);
                  }
-                 w[i] = newps_mod(g,m);
+                 if ( g ) {
+                         w[i] = newps_mod(g,m);
+                 } else {
+                         w[i] = -1;
+                 }
          }
          for ( top = 0, j = n-1; j >= 0; j-- ) {
-                 MKNODE(t,(pointer)w[j],top); top = t;
+                 if ( w[j] >= 0 ) {
+                         MKNODE(t,(pointer)w[j],top); top = t;
+                 }
          }
          *h = top;
-         if ( Print || PrintShort )
+         if ( DP_Print || DP_PrintShort )
                  fprintf(asir_out,"\n");
  }
- int newps(a,m,subst)
+ int newps(DP a,int m,NODE subst)
- DP a;
- int m;
- NODE subst;
  {
          if ( m && !validhc(!a?0:BDY(a)->c,m,subst) )
                  return -1;
-Line 1127  NODE subst;
+Line 1543  NODE subst;
 Line 1127  NODE subst;
 Line 1543  NODE subst;
                          ps[psn] = a;
                  else
                          ps[psn] = 0;
-                 dp_save(psn,a);
+                 dp_save(psn,(Obj)a,0);
          } else
                  ps[psn] = a;
          psh[psn] = BDY(a)->dl;
-Line 1135  NODE subst;
+Line 1551  NODE subst;
 Line 1135  NODE subst;
 Line 1551  NODE subst;
          psc[psn] = BDY(a)->c;
          if ( m )
                  _dp_mod(a,m,subst,&psm[psn]);
+         if ( GenTrace ) {
+                 NODE tn,tr,tr1;
+                 LIST trace,trace1;
+                 NODE arg;
+                 Q q1,q2;
+                 STRING fname;
+                 Obj obj;
+                 /* reverse the TraceList */
+                 tn = TraceList;
+                 for ( tr = 0; tn; tn = NEXT(tn) ) {
+                         MKNODE(tr1,BDY(tn),tr); tr = tr1;
+                 }
+                 MKLIST(trace,tr);
+                 if ( OXCheck >= 0 ) {
+                         STOQ(OXCheck,q1);
+                         MKSTR(fname,"check_trace");
+                         STOQ(psn,q2);
+                         arg = mknode(5,q1,fname,a,q2,trace);
+                         Pox_cmo_rpc(arg,&obj);
+                 } else if ( OXCheck < 0 ) {
+                         STOQ(psn,q1);
+                         tn = mknode(2,q1,trace);
+                         MKLIST(trace1,tn);
+                         MKNODE(tr,trace1,AllTraceList);
+                         AllTraceList = tr;
+                 } else
+                         dp_save(psn,(Obj)trace,"t");
+                 TraceList = 0;
+         }
          return psn++;
  }
- int newps_nosave(a,m,subst)
+ int newps_nosave(DP a,int m,NODE subst)
- DP a;
- int m;
- NODE subst;
  {
          if ( m && !validhc(!a?0:BDY(a)->c,m,subst) )
                  return -1;
-Line 1163  NODE subst;
+Line 1606  NODE subst;
 Line 1163  NODE subst;
 Line 1606  NODE subst;
          return psn++;
  }
- int newps_mod(a,m)
+ int newps_mod(DP a,int m)
- DP a;
- int m;
  {
          if ( psn == pslen ) {
                  pslen *= 2;
-Line 1180  int m;
+Line 1621  int m;
 Line 1180  int m;
 Line 1621  int m;
          return psn++;
  }
- void reducebase_dehomo(f,g)
+ void reducebase_dehomo(NODE f,NODE *g)
- NODE f,*g;
  {
          int n,i,j,k;
          int *r;
-Line 1210  NODE f,*g;
+Line 1650  NODE f,*g;
 Line 1210  NODE f,*g;
 Line 1650  NODE f,*g;
          }
          for ( top = 0, i = n-1; i >= 0; i-- )
                  if ( r[i] >= 0 ) {
-                         dp_load(r[i],&ps[r[i]]); dp_dehomo(ps[r[i]],&u); j = newps(u,0,0);
+                         dp_load(r[i],&ps[r[i]]); dp_dehomo(ps[r[i]],&u);
+                         if ( GenTrace ) {
+                                 Q q;
+                                 LIST hist;
+                                 NODE node;
+                                 STOQ(r[i],q);
+                                 node = mknode(4,NULLP,q,NULLP,NULLP);
+                                 MKLIST(hist,node);
+                                 MKNODE(TraceList,hist,0);
+                         }
+                         j = newps(u,0,0);
                          MKNODE(t,j,top); top = t;
                  }
          *g = top;
  }
- NODE append_one(f,n)
+ NODE append_one(NODE f,int n)
- NODE f;
- int n;
  {
          NODE t;
-Line 1231  int n;
+Line 1680  int n;
 Line 1231  int n;
 Line 1680  int n;
          }
  }
- DP_pairs minp( d, prest )
+ DP_pairs minp( DP_pairs d, DP_pairs *prest )
- DP_pairs d, *prest;
  {
          register DP_pairs m, ml, p, l;
          register DL lcm;
-Line 1257  DP_pairs d, *prest;
+Line 1705  DP_pairs d, *prest;
 Line 1257  DP_pairs d, *prest;
 Line 1705  DP_pairs d, *prest;
          return m;
  }
- void minsugar(d,dm,dr)
+ void minsugar(DP_pairs d,DP_pairs *dm,DP_pairs *dr)
- DP_pairs d;
- DP_pairs *dm,*dr;
  {
          int msugar;
          DP_pairs t,dm0,dr0,dmt,drt;
-Line 1284  DP_pairs *dm,*dr;
+Line 1730  DP_pairs *dm,*dr;
 Line 1284  DP_pairs *dm,*dr;
 Line 1730  DP_pairs *dm,*dr;
          *dm = dm0; *dr = dr0;
  }
- NODE gb(f,m,subst)
+ NODE gb(NODE f,int m,NODE subst)
- NODE f;
- int m;
- NODE subst;
  {
-         int i,nh,prev,mag;
+         int i,nh,prev,mag,mag0,magt;
          NODE r,g,gall;
-         DP_pairs d,d1;
+         DP_pairs d;
          DP_pairs l;
          DP h,nf,nfm,dp1,dp2;
          MP mp;
-         struct oEGT tnf0,tnf1,tnfm0,tnfm1,tpz0,tpz1,tsp0,tsp1,tspm0,tspm1,tnp0,tnp1,tmp0,tmp1;
+         struct oEGT tnf0,tnf1,tnfm0,tnfm1,tpz0,tpz1,tnp0,tnp1;
          int skip_nf_flag;
          double t_0;
+         Q q;
+         int new_sugar;
          static prev_sugar = -1;
          Max_mag = 0;
+         Max_coef = 0;
          prev = 1;
          doing_f4 = 0;
+         init_denomlist();
          if ( m ) {
                  psm = (DP *)MALLOC(pslen*sizeof(DP));
                  for ( i = 0; i < psn; i++ )
-Line 1318  NODE subst;
+Line 1765  NODE subst;
 Line 1318  NODE subst;
 Line 1765  NODE subst;
                  gall = append_one(gall,i);
          }
          while ( d ) {
-                 get_eg(&tmp0);
+                 l = minp(d,&d);
-                 l = minp(d,&d1); d = d1;
-                 get_eg(&tmp1); add_eg(&eg_mp,&tmp0,&tmp1);
                  if ( m ) {
-                         get_eg(&tspm0);
+                         _dp_sp_mod_dup(psm[l->dp1],psm[l->dp2],m,&h);
-                         _dp_sp_mod(psm[l->dp1],psm[l->dp2],m,&h);
+                         if ( h )
-                         get_eg(&tspm1); add_eg(&eg_spm,&tspm0,&tspm1);
+                                 new_sugar = h->sugar;
                          get_eg(&tnfm0);
-                         _dp_nf_mod(gall,h,psm,m,0,&nfm);
+                         _dp_nf_mod_destructive(gall,h,psm,m,0,&nfm);
                          get_eg(&tnfm1); add_eg(&eg_nfm,&tnfm0,&tnfm1);
                  } else
                          nfm = (DP)1;
                  if ( nfm ) {
-                         get_eg(&tsp0);
                          if ( Demand ) {
                                  if ( dp_load_t(psn,&nf) ) {
                                          skip_nf_flag = 1;
-                                         get_eg(&tsp1); add_eg(&eg_nf,&tsp0,&tsp1);
-                                         tnf0=tsp0; tnf1=tsp1;
                                          goto skip_nf;
                                  } else {
                                          skip_nf_flag = 0;
-Line 1345  NODE subst;
+Line 1787  NODE subst;
 Line 1345  NODE subst;
 Line 1787  NODE subst;
                                  }
                          } else
                                  dp_sp(ps[l->dp1],ps[l->dp2],&h);
-                         get_eg(&tsp1); add_eg(&eg_sp,&tsp0,&tsp1);
+                         if ( GenTrace ) {
+                                 STOQ(l->dp1,q); ARG1(BDY((LIST)BDY(NEXT(TraceList)))) = q;
+                                 STOQ(l->dp2,q); ARG1(BDY((LIST)BDY(TraceList))) = q;
+                         }
+                         if ( h )
+                                 new_sugar = h->sugar;
                          get_eg(&tnf0);
                          t_0 = get_rtime();
-                         if ( !Multiple )
+                         if ( PCoeffs || dp_fcoeffs )
                                  _dp_nf(gall,h,ps,!Top,&nf);
                          else
- #if MPI
+                                 _dp_nf_z(gall,h,ps,!Top,DP_Multiple,&nf);
-                                 _dp_nf_ptozp_mpi(gall,h,ps,!Top,Multiple,&nf);
+                         if ( DP_Print && nf )
- #else
-                                 _dp_nf_ptozp(gall,h,ps,!Top,Multiple,&nf);
- #endif
-                         if ( Print )
                                  fprintf(asir_out,"(%.3g)",get_rtime()-t_0);
                          get_eg(&tnf1); add_eg(&eg_nf,&tnf0,&tnf1);
                  } else
-Line 1367  skip_nf:
+Line 1810  skip_nf:
 Line 1367  skip_nf:
 Line 1810  skip_nf:
                          get_eg(&tpz0);
                          prim_part(nf,0,&h);
                          get_eg(&tpz1); add_eg(&eg_pz,&tpz0,&tpz1);
+                         add_denomlist(BDY(h)->c);
                          get_eg(&tnp0);
                          if ( Demand && skip_nf_flag )
                                  nh = newps_nosave(h,m,subst);
-Line 1379  skip_nf:
+Line 1823  skip_nf:
 Line 1379  skip_nf:
 Line 1823  skip_nf:
                          g = updbase(g,nh);
                          gall = append_one(gall,nh);
                          if ( !dp_fcoeffs && ShowMag ) {
-                                 for ( mag = 0, mp = BDY(h); mp; mp = NEXT(mp) )
+                                 for ( mag = 0, mag0 = 0, mp = BDY(h); mp; mp = NEXT(mp) ) {
-                                         mag += p_mag((P)mp->c);
+                                         magt = p_mag((P)mp->c);
+                                         mag0 = MAX(mag0,magt);
+                                         mag += magt;
+                                 }
+                                 Max_coef = MAX(Max_coef,mag0);
                                  Max_mag = MAX(Max_mag,mag);
                          }
-                         if ( Print ) {
+                         if ( DP_Print ) {
                                  if ( !prev )
                                          fprintf(asir_out,"\n");
                                  print_split_e(&tnf0,&tnf1); print_split_e(&tpz0,&tpz1);
-Line 1392  skip_nf:
+Line 1840  skip_nf:
 Line 1392  skip_nf:
 Line 1840  skip_nf:
                                          l->dp1,l->dp2,length(g),length(gall),DPPlength(d),
                                          pss[nh]);
                                  if ( ShowMag )
-                                         fprintf(asir_out,",mag=%d",mag);
+                                         fprintf(asir_out,",mag=(%d,%d)",mag,mag0);
                                  fprintf(asir_out,"\n"); fflush(asir_out);
-                         } else if ( PrintShort ) {
+                         } else if ( DP_PrintShort ) {
                                  fprintf(asir_out,"+"); fflush(asir_out);
                          }
                          prev = 1;
-Line 1402  skip_nf:
+Line 1850  skip_nf:
 Line 1402  skip_nf:
 Line 1850  skip_nf:
                          if ( m )
                                  add_eg(&eg_znfm,&tnfm0,&tnfm1);
                          ZR++;
-                         if ( Print || PrintShort ) {
+                         if ( DP_Print || DP_PrintShort ) {
-                                 if ( h && (h->sugar != prev_sugar) ) {
+                                 if ( new_sugar != prev_sugar ) {
-                                         fprintf(asir_out,"[%d]",h->sugar);
+                                         fprintf(asir_out,"[%d]",new_sugar);
-                                         prev_sugar = h->sugar;
+                                         prev_sugar = new_sugar;
                                  }
                                  fprintf(asir_out,"."); fflush(asir_out); prev = 0;
                          }
                  }
          }
-         if ( Print || PrintShort )
+         if ( DP_Print || DP_PrintShort )
                  fprintf(asir_out,"gb done\n");
          return g;
  }
- NODE gbd(f,m,subst,dlist)
+ NODE gb_mod(NODE f,int m)
- NODE f;
- int m;
- NODE subst;
- NODE dlist;
  {
          int i,nh,prev;
          NODE r,g,gall;
-         struct dp_pairs ol;
+         DP_pairs d;
          DP_pairs l;
-         NODE pair;
-         DP h,nf,nfm,dp1,dp2;
-         struct oEGT tnf0,tnf1,tnfm0,tnfm1,tpz0,tpz1,tsp0,tsp1,tspm0,tspm1,tnp0,tnp1;
-         prev = 1;
-         l = &ol;
-         if ( m ) {
-                 psm = (DP *)MALLOC(pslen*sizeof(DP));
-                 for ( i = 0; i < psn; i++ )
-                         if ( psh[i] && !validhc(psc[i],m,subst) )
-                                 return 0;
-                         else
-                                 _dp_mod(ps[i],m,subst,&psm[i]);
-         }
-         for ( gall = g = 0, r = f; r; r = NEXT(r) ) {
-                 i = (int)BDY(r);
-                 g = updbase(g,i);
-                 gall = append_one(gall,i);
-         }
-         while ( dlist ) {
-                 pair = BDY((LIST)BDY(dlist)); dlist = NEXT(dlist);
-                 l->dp1 = QTOS((Q)BDY(pair)); pair = NEXT(pair);
-                 l->dp2 = QTOS((Q)BDY(pair));
-                 if ( m ) {
-                         get_eg(&tspm0);
-                         _dp_sp_mod(psm[l->dp1],psm[l->dp2],m,&h);
-                         get_eg(&tspm1); add_eg(&eg_spm,&tspm0,&tspm1);
-                         get_eg(&tnfm0);
-                         _dp_nf_mod(gall,h,psm,m,0,&nfm);
-                         get_eg(&tnfm1); add_eg(&eg_nfm,&tnfm0,&tnfm1);
-                 } else
-                         nfm = (DP)1;
-                 if ( nfm ) {
-                         get_eg(&tsp0);
-                         if ( Demand ) {
-                                 dp_load(l->dp1,&dp1); dp_load(l->dp2,&dp2);
-                                 dp_sp(dp1,dp2,&h);
-                         } else
-                                 dp_sp(ps[l->dp1],ps[l->dp2],&h);
-                         get_eg(&tsp1); add_eg(&eg_sp,&tsp0,&tsp1);
-                         get_eg(&tnfm0);
-                         get_eg(&tnf0);
-                         if ( !Multiple )
-                                 _dp_nf(gall,h,ps,!Top,&nf);
-                         else
-                                 _dp_nf_ptozp(gall,h,ps,!Top,Multiple,&nf);
-                         get_eg(&tnf1); add_eg(&eg_nf,&tnf0,&tnf1);
-                 } else
-                         nf = 0;
-                 if ( nf ) {
-                         NZR++;
-                         get_eg(&tpz0);
-                         prim_part(nf,0,&h);
-                         get_eg(&tpz1); add_eg(&eg_pz,&tpz0,&tpz1);
-                         get_eg(&tnp0);
-                         nh = newps(h,m,subst);
-                         get_eg(&tnp1); add_eg(&eg_np,&tnp0,&tnp1);
-                         if ( nh < 0 )
-                                 return 0;
-                         g = updbase(g,nh);
-                         gall = append_one(gall,nh);
-                         if ( Print ) {
-                                 if ( !prev )
-                                         fprintf(asir_out,"\n");
-                                 print_split_eg(&tnf0,&tnf1); fflush(asir_out);
-                                 fprintf(asir_out,"(%d,%d),nb=%d,nab=%d,rp=%d,sugar=%d",l->dp1,l->dp2,length(g),length(gall),length(dlist),pss[nh]);
-                                 printdl(psh[nh]); fprintf(asir_out,"\n"); fflush(asir_out);
-                         }
-                         prev = 1;
-                 } else {
-                         if ( m )
-                                 add_eg(&eg_znfm,&tnfm0,&tnfm1);
-                         ZR++;
-                         if ( Print ) {
-                                 fprintf(asir_out,"."); fflush(asir_out); prev = 0;
-                         }
-                 }
-         }
-         if ( Print )
-                 fprintf(asir_out,"gb done\n");
-         return g;
- }
- NODE gb_mod(f,m)
- NODE f;
- int m;
- {
-         int i,nh,prev;
-         NODE r,g,gall;
-         DP_pairs d,d1;
-         DP_pairs l;
          DP h,nf;
-         struct oEGT tnfm0,tnfm1,tspm0,tspm1,tmp0,tmp1,tpz0,tpz1;
+         struct oEGT tnfm0,tnfm1,tpz0,tpz1;
          prev = 1;
          for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
-Line 1528  int m;
+Line 1881  int m;
 Line 1528  int m;
 Line 1881  int m;
                  gall = append_one(gall,i);
          }
          while ( d ) {
-                 get_eg(&tmp0);
+                 l = minp(d,&d);
-                 l = minp(d,&d1); d = d1;
-                 get_eg(&tmp1); add_eg(&eg_mp,&tmp0,&tmp1); get_eg(&tspm0);
                  if ( PCoeffs ) {
                          dp_sp_mod(ps[l->dp1],ps[l->dp2],m,&h);
-                         get_eg(&tspm1); add_eg(&eg_spm,&tspm0,&tspm1); get_eg(&tnfm0);
+                         get_eg(&tnfm0);
                          dp_nf_mod(gall,h,ps,m,!Top,&nf);
                  } else {
-                         _dp_sp_mod(ps[l->dp1],ps[l->dp2],m,&h);
+                         _dp_sp_mod_dup(ps[l->dp1],ps[l->dp2],m,&h);
-                         get_eg(&tspm1); add_eg(&eg_spm,&tspm0,&tspm1); get_eg(&tnfm0);
+                         get_eg(&tnfm0);
-                         _dp_nf_mod(gall,h,ps,m,!Top,&nf);
+                         _dp_nf_mod_destructive(gall,h,ps,m,!Top,&nf);
                  }
                  get_eg(&tnfm1); add_eg(&eg_nfm,&tnfm0,&tnfm1);
                  if ( nf ) {
-Line 1551  int m;
+Line 1902  int m;
 Line 1551  int m;
 Line 1902  int m;
                                  return 0;
                          d = updpairs(d,g,nh);
                          g = updbase(g,nh);
-                         if ( InterReduce )
-                                 interreduce_mod(g,nh,m);
                          gall = append_one(gall,nh);
-                         if ( Print ) {
+                         if ( DP_Print ) {
                                  if ( !prev )
                                          fprintf(asir_out,"\n");
                                  print_split_eg(&tnfm0,&tnfm1); fflush(asir_out);
                                  fprintf(asir_out,"(%d,%d),nb=%d,nab=%d,rp=%d,sugar=%d",l->dp1,l->dp2,length(g),length(gall),DPPlength(d),pss[nh]);
                                  printdl(psh[nh]); fprintf(asir_out,"\n"); fflush(asir_out);
+                         } else if ( DP_PrintShort ) {
+                                 fprintf(asir_out,"+"); fflush(asir_out);
                          }
                          prev = 1;
                  } else {
                          add_eg(&eg_znfm,&tnfm0,&tnfm1);
                          ZR++;
-                         if ( Print ) {
+                         if ( DP_Print || DP_PrintShort ) {
                                  fprintf(asir_out,"."); fflush(asir_out); prev = 0;
                          }
                  }
          }
-         if ( Print )
+         if ( DP_Print || DP_PrintShort )
                  fprintf(asir_out,"gb_mod done\n");
          return g;
  }
- void interreduce_mod(g,n,m)
+ DP_pairs updpairs( DP_pairs d, NODE /* of index */ g, int t)
- NODE g;
- int n,m;
  {
-         DP nf;
-         NODE gn,t;
-         int i;
-         MKNODE(gn,(pointer)n,0);
-         if ( PCoeffs )
-                 for ( t = g; t; t = NEXT(t) ) {
-                         i = (int)BDY(t);
-                         if ( i != n ) {
-                                 dp_nf_mod(gn,ps[i],ps,m,1,&nf); ps[i] = nf;
-                         }
-                 }
-         else
-                 for ( t = g; t; t = NEXT(t) ) {
-                         i = (int)BDY(t);
-                         if ( i != n ) {
-                                 _dp_nf_mod(gn,ps[i],ps,m,1,&nf); ps[i] = nf;
-                         }
-                 }
- }
- void _dp_nf_mod(b,g,ps,mod,full,rp)
- NODE b;
- DP g;
- DP *ps;
- int mod,full;
- DP *rp;
- {
-         DP u,p,d,s,t;
-         NODE l;
-         MP m,mr;
-         int sugar,psugar;
-         if ( !g ) {
-                 *rp = 0; return;
-         }
-         sugar = g->sugar;
-         for ( d = 0; g; ) {
-                 for ( u = 0, l = b; l; l = NEXT(l) ) {
-                         if ( dp_redble(g,p = ps[(int)BDY(l)]) ) {
-                                 _dp_red_mod(g,p,mod,&u);
-                                 psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
-                                 sugar = MAX(sugar,psugar);
-                                 if ( !u ) {
-                                         if ( d )
-                                                 d->sugar = sugar;
-                                         *rp = d; return;
-                                 }
-                                 break;
-                         }
-                 }
-                 if ( u )
-                         g = u;
-                 else if ( !full ) {
-                         if ( g ) {
-                                 MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
-                         }
-                         *rp = g; return;
-                 } else {
-                         m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
-                         NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
-                         _addmd(CO,mod,d,t,&s); d = s;
-                         dp_rest(g,&t); g = t;
-                 }
-         }
-         if ( d )
-                 d->sugar = sugar;
-         *rp = d;
- }
- void _dp_nf(b,g,ps,full,rp)
- NODE b;
- DP g;
- DP *ps;
- int full;
- DP *rp;
- {
-         DP u,p,d,s,t;
-         P dmy;
-         NODE l;
-         MP m,mr;
-         int sugar,psugar;
-         if ( !g ) {
-                 *rp = 0; return;
-         }
-         sugar = g->sugar;
-         for ( d = 0; g; ) {
-                 for ( u = 0, l = b; l; l = NEXT(l) ) {
-                         if ( dl_redble(BDY(g)->dl,psh[(int)BDY(l)]) ) {
-                                 dp_load((int)BDY(l),&p);
-                                 dp_red(d,g,p,&t,&u,&dmy);
-                                 psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
-                                 sugar = MAX(sugar,psugar);
-                                 if ( !u ) {
-                                         if ( d )
-                                                 d->sugar = sugar;
-                                         *rp = d; return;
-                                 }
-                                 d = t;
-                                 break;
-                         }
-                 }
-                 if ( u )
-                         g = u;
-                 else if ( !full ) {
-                         if ( g ) {
-                                 MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
-                         }
-                         *rp = g; return;
-                 } else {
-                         m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
-                         NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
-                         addd(CO,d,t,&s); d = s;
-                         dp_rest(g,&t); g = t;
-                 }
-         }
-         if ( d )
-                 d->sugar = sugar;
-         *rp = d;
- }
- #define SAFENM(q) ((q)?NM(q):0)
- double pz_t_e, pz_t_d, pz_t_d1, pz_t_c, im_t_s, im_t_r;
- void _dp_nf_ptozp(b,g,ps,full,multiple,r)
- NODE b;
- DP g;
- DP *ps;
- int full,multiple;
- DP *r;
- {
-         DP u,dp,rp,t,t1,t2,red,shift;
-         Q dc,rc,dcq,rcq,cont,hr,hred,cr,cred,mcred,c,gcd,cq;
-         N gn,tn,cn;
-         NODE l;
-         MP m,mr;
-         int hmag,denom;
-         int sugar,psugar;
-         NODE dist;
-         STRING imul;
-         int ndist;
-         int kara_bit;
-         extern int kara_mag;
-         double get_rtime();
-         double t_0,t_00,tt,ttt,t_p,t_m,t_m1,t_m2,t_s,t_g,t_a;
-         if ( !g ) {
-                 *r = 0; return;
-         }
-         pz_t_e = pz_t_d = pz_t_d1 = pz_t_c = 0;
-         t_p = t_m = t_m1 = t_m2 = t_s = t_g = t_a = 0;
-         denom = Denominator?Denominator:1;
-         hmag = multiple*HMAG(g)/denom;
-         kara_bit = kara_mag*27; /* XXX */
-         if ( Dist ) {
-                 dist = BDY(Dist);
-                 ndist = length(dist);
-         }
-         sugar = g->sugar;
-         dc = 0; dp = 0; rc = ONE; rp = g;
-         MKSTR(imul,"dp_imul_index");
-         for ( ; rp; ) {
-                 for ( u = 0, l = b; l; l = NEXT(l) ) {
-                         if ( dl_redble(BDY(rp)->dl,psh[(int)BDY(l)]) ) {
-                                 t_0 = get_rtime();
-                                 dp_load((int)BDY(l),&red);
-                                 hr = (Q)BDY(rp)->c; hred = (Q)BDY(red)->c;
-                                 gcdn(NM(hr),NM(hred),&gn);
-                                 divsn(NM(hred),gn,&tn); NTOQ(tn,SGN(hred),cr);
-                                 divsn(NM(hr),gn,&tn); NTOQ(tn,SGN(hr),cred);
-                                 tt = get_rtime()-t_0; t_p += tt;
-                                 t_0 = get_rtime();
-                                 dp_subd(rp,red,&shift);
- #if INET
-                                 if ( Dist && ndist && HMAG(red) > kara_bit ) {
-                                         NODE n0,n1,n2,n3;
-                                         int i,s,id;
-                                         Obj dmy;
-                                         Q ind;
-                                         if ( Print )
-                                                 fprintf(asir_out,"d");
-                                         i = (int)BDY(l); STOQ(i,ind);
-                                         chsgnp((P)cred,(P *)&mcred);
-                                         MKNODE(n3,ind,0); MKNODE(n2,mcred,n3);
-                                         MKNODE(n1,imul,n2); MKNODE(n0,BDY(dist),n1);
-                                         Pox_rpc(n0,&dmy);
-                                         muldc(CO,rp,(P)cr,&t);
-                                         NEXT(n0)=0;
-                                         Pox_pop_local(n0,&t1);
-                                 } else
- #endif
-                                 {
- /*
-                                         if ( Print )
-                                                 fprintf(asir_out,"l");
- */
-                                         t_00 = get_rtime();
-                                         muldc(CO,rp,(P)cr,&t);
-                                         ttt = get_rtime()-t_00; t_m1 += ttt/dp_nt(rp);
-                                         t_00 = get_rtime();
-                                         chsgnp((P)cred,(P *)&mcred);
-                                         muldc(CO,red,(P)mcred,&t1);
-                                         ttt = get_rtime()-t_00; t_m2 += ttt/dp_nt(red);
-                                 }
-                                 t_00 = get_rtime();
-                                 muld(CO,shift,t1,&t2);
-                                 addd(CO,t,t2,&u);
-                                 tt = get_rtime(); t_m += tt-t_0;
-                                 ttt = get_rtime(); t_s += ttt-t_00;
-                                 psugar = (BDY(rp)->dl->td - BDY(red)->dl->td) + red->sugar;
-                                 sugar = MAX(sugar,psugar);
-                                 if ( !u ) {
-                                         if ( dp )
-                                                 dp->sugar = sugar;
-                                         *r = dp;
-                                         goto final;
-                                 }
-                                 break;
-                         }
-                 }
-                 if ( u ) {
-                         if ( HMAG(u) > hmag ) {
-                                 t_0 = get_rtime();
- #if INET
-                                 if ( Dist && HMAG(u) > kara_bit ) {
-                                         if ( Print )
-                                                 fprintf(asir_out,"D");
-                                         dp_ptozp_d(dist,ndist,u,&t);
-                                 } else {
-                                         if ( Print )
-                                                 fprintf(asir_out,"L");
-                                         dp_ptozp_d(0,0,u,&t);
-                                 }
- #else
-                                 dp_ptozp(u,&t); /* XXX */
- #endif
-                                 tt = get_rtime()-t_0; t_g += tt;
-                                 t_0 = get_rtime();
-                                 divsn(NM((Q)BDY(u)->c),NM((Q)BDY(t)->c),&cn); NTOQ(cn,1,cont);
-                                 if ( !dp_fcoeffs && Print ) {
-                                         fprintf(asir_out,"(%d)",p_mag((P)cont)*100/p_mag((P)BDY(u)->c));
-                                         fflush(asir_out);
-                                 }
-                                 mulq(cr,dc,&dcq);
-                                 mulq(cont,rc,&rcq);
-                                 gcdn(SAFENM(dcq),SAFENM(rcq),&gn);
-                                 divsn(SAFENM(dcq),gn,&tn); NTOQ(tn,SGN(dcq),dc);
-                                 divsn(SAFENM(rcq),gn,&tn); NTOQ(tn,SGN(rcq),rc);
-                                 tt = get_rtime()-t_0; t_a += tt;
-                                 rp = t;
-                                 hmag = multiple*HMAG(rp)/denom;
-                         } else {
-                                 t_0 = get_rtime();
-                                 mulq(cr,dc,&dcq); dc = dcq;
-                                 tt = get_rtime()-t_0; t_a += tt;
-                                 rp = u;
-                         }
-                 } else if ( !full ) {
-                         if ( rp ) {
-                                 MKDP(rp->nv,BDY(rp),t); t->sugar = sugar; rp = t;
-                         }
-                         *r = rp;
-                         goto final;
-                 } else {
-                         t_0 = get_rtime();
-                         mulq((Q)BDY(rp)->c,rc,&c);
-                         gcdn(SAFENM(dc),SAFENM(c),&gn); NTOQ(gn,1,gcd);
-                         divsn(SAFENM(dc),gn,&tn); NTOQ(tn,SGN(dc),dcq);
-                         divsn(SAFENM(c),gn,&tn); NTOQ(tn,SGN(c),cq);
-                         muldc(CO,dp,(P)dcq,&t1);
-                         m = BDY(rp); NEWMP(mr); mr->dl = m->dl; mr->c = (P)cq;
-                         NEXT(mr) = 0; MKDP(rp->nv,mr,t); t->sugar = mr->dl->td;
-                         addd(CO,t,t1,&dp);
-                         dc = gcd;
-                         dp_rest(rp,&t); rp = t;
-                         tt = get_rtime()-t_0; t_a += tt;
-                 }
-         }
-         if ( dp )
-                 dp->sugar = sugar;
-         *r = dp;
- final:
-         if ( Print )
-                 fprintf(asir_out,"(%.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g)",
-                         t_p,t_m,t_m1,t_m2,t_s,
-                         t_g,t_a,
-                         pz_t_e, pz_t_d, pz_t_d1, pz_t_c);
- }
- void dp_imul_d();
- void imulv();
- void _dp_nf_ptozp_mpi(b,g,ps,full,multiple,r)
- NODE b;
- DP g;
- DP *ps;
- int full,multiple;
- DP *r;
- {
-         Obj dmy;
-         DP u,dp,rp,t,t1,t2,red,shift;
-         Q dc,rc,dcq,rcq,cont,hr,hred,cr,cred,mcred,c,gcd,cq;
-         N gn,tn,cn;
-         NODE l,n0,n1,n2,n3;
-         MP m,mr;
-         int i,n;
-         int hmag,denom;
-         int sugar,psugar;
-         NODE dist;
-         STRING imul;
-         int ndist;
-         int kara_bit;
-         extern int kara_mag;
-         extern int mpi_mag;
-         Q ind;
-         int id;
-         double get_rtime();
-         double t_0,t_00,tt,ttt,t_p,t_m,t_m1,t_m2,t_s,t_g,t_a;
-         if ( !g ) {
-                 *r = 0; return;
-         }
-         pz_t_e = pz_t_d = pz_t_d1 = pz_t_c = 0;
-         t_p = t_m = t_m1 = t_m2 = t_s = t_g = t_a = 0;
-         denom = Denominator?Denominator:1;
-         hmag = multiple*HMAG(g)/denom;
-         kara_bit = kara_mag*27; /* XXX */
-         if ( Dist ) {
-                 dist = BDY(Dist);
-                 ndist = length(dist);
-         }
-         sugar = g->sugar;
-         dc = 0; dp = 0; rc = ONE; rp = g;
-         MKSTR(imul,"dp_imul_index");
-         for ( ; rp; ) {
-                 for ( u = 0, l = b; l; l = NEXT(l) ) {
-                         if ( dl_redble(BDY(rp)->dl,psh[(int)BDY(l)]) ) {
-                                 t_0 = get_rtime();
-                                 dp_load((int)BDY(l),&red);
-                                 hr = (Q)BDY(rp)->c; hred = (Q)BDY(red)->c;
-                                 gcdn(NM(hr),NM(hred),&gn);
-                                 divsn(NM(hred),gn,&tn); NTOQ(tn,SGN(hred),cr);
-                                 divsn(NM(hr),gn,&tn); NTOQ(tn,SGN(hr),cred);
-                                 tt = get_rtime()-t_0; t_p += tt;
-                                 t_0 = get_rtime();
-                                 dp_subd(rp,red,&shift);
-                                 t_00 = get_rtime();
-                                 if ( Dist && ndist
-                                         && HMAG(rp) > mpi_mag && p_mag((P)cr) > mpi_mag ) {
-                                         if ( Print ) fprintf(asir_out,"~");
-                                         dp_imul_d(rp,cr,&t);
-                                 } else {
-                                         if ( Print ) fprintf(asir_out,"_");
-                                         muldc(CO,rp,(P)cr,&t);
-                                 }
-                                 ttt = get_rtime()-t_00; t_m1 += ttt/dp_nt(rp);
-                                 t_00 = get_rtime();
-                                 chsgnp((P)cred,(P *)&mcred);
-                                 if ( Dist && ndist
-                                         && HMAG(red) > mpi_mag && p_mag((P)mcred) > mpi_mag ) {
-                                         if ( Print ) fprintf(asir_out,"=");
-                                         dp_imul_d(red,mcred,&t1);
-                                 } else {
-                                         if ( Print ) fprintf(asir_out,"_");
-                                         muldc(CO,red,(P)mcred,&t1);
-                                 }
-                                 ttt = get_rtime()-t_00; t_m2 += ttt/dp_nt(red);
-                                 t_00 = get_rtime();
-                                 muld(CO,shift,t1,&t2);
-                                 addd(CO,t,t2,&u);
-                                 tt = get_rtime(); t_m += tt-t_0;
-                                 ttt = get_rtime(); t_s += ttt-t_00;
-                                 psugar = (BDY(rp)->dl->td - BDY(red)->dl->td) + red->sugar;
-                                 sugar = MAX(sugar,psugar);
-                                 if ( !u ) {
-                                         if ( dp )
-                                                 dp->sugar = sugar;
-                                         *r = dp;
-                                         goto final;
-                                 }
-                                 break;
-                         }
-                 }
-                 if ( u ) {
-                         if ( HMAG(u) > hmag ) {
-                                 t_0 = get_rtime();
-                                 if ( Dist && HMAG(u) > mpi_mag ) {
-                                         if ( Print )
-                                                 fprintf(asir_out,"D");
-                                         dp_ptozp_d(dist,ndist,u,&t);
-                                 } else {
-                                         if ( Print )
-                                                 fprintf(asir_out,"L");
-                                         dp_ptozp_d(0,0,u,&t);
-                                 }
-                                 tt = get_rtime()-t_0; t_g += tt;
-                                 t_0 = get_rtime();
-                                 divsn(NM((Q)BDY(u)->c),NM((Q)BDY(t)->c),&cn); NTOQ(cn,1,cont);
-                                 if ( Print ) {
-                                         fprintf(asir_out,"(%d)",p_mag((P)cont)*100/p_mag((P)BDY(u)->c));
-                                         fflush(asir_out);
-                                 }
-                                 mulq(cr,dc,&dcq);
-                                 mulq(cont,rc,&rcq);
-                                 gcdn(SAFENM(dcq),SAFENM(rcq),&gn);
-                                 divsn(SAFENM(dcq),gn,&tn); NTOQ(tn,SGN(dcq),dc);
-                                 divsn(SAFENM(rcq),gn,&tn); NTOQ(tn,SGN(rcq),rc);
-                                 tt = get_rtime()-t_0; t_a += tt;
-                                 rp = t;
-                                 hmag = multiple*HMAG(rp)/denom;
-                         } else {
-                                 t_0 = get_rtime();
-                                 mulq(cr,dc,&dcq); dc = dcq;
-                                 tt = get_rtime()-t_0; t_a += tt;
-                                 rp = u;
-                         }
-                 } else if ( !full ) {
-                         if ( rp ) {
-                                 MKDP(rp->nv,BDY(rp),t); t->sugar = sugar; rp = t;
-                         }
-                         *r = rp;
-                         goto final;
-                 } else {
-                         t_0 = get_rtime();
-                         mulq((Q)BDY(rp)->c,(Q)rc,(Q *)&c);
-                         gcdn(SAFENM(dc),SAFENM(c),&gn); NTOQ(gn,1,gcd);
-                         divsn(SAFENM(dc),gn,&tn); NTOQ(tn,SGN(dc),dcq);
-                         divsn(SAFENM(c),gn,&tn); NTOQ(tn,SGN(c),cq);
-                         muldc(CO,dp,(P)dcq,&t1);
-                         m = BDY(rp); NEWMP(mr); mr->dl = m->dl; mr->c = (P)cq;
-                         NEXT(mr) = 0; MKDP(rp->nv,mr,t); t->sugar = mr->dl->td;
-                         addd(CO,t,t1,&dp);
-                         dc = gcd;
-                         dp_rest(rp,&t); rp = t;
-                         tt = get_rtime()-t_0; t_a += tt;
-                 }
-         }
-         if ( dp )
-                 dp->sugar = sugar;
-         *r = dp;
- final:
-         if ( Print )
-                 fprintf(asir_out,"(%.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g)",
-                         t_p,t_m,t_m1,t_m2,t_s,
-                         t_g,t_a,
-                         pz_t_e, pz_t_d, pz_t_d1, pz_t_c);
- }
- void dp_imul_d(p,q,rp)
- DP p;
- Q q;
- DP *rp;
- {
-         int nsep,ndist,i,j,k,l,n;
-         double t0,t1,t2;
-         Q *s;
-         pointer *b;
-         VECT c,cs,ri;
-         VECT *r;
-         MP m;
-         NODE tn,dist,n0,n1,n2;
-         Obj dmy;
-         STRING imul;
-         extern LIST Dist;
-         if ( !p || !q ) {
-                 *rp = 0; return;
-         }
-         dist = BDY(Dist);
-         for ( tn = dist, ndist = 0; tn; tn = NEXT(tn), ndist++ );
-         nsep = ndist + 1;
-         for ( m = BDY(p), n = 0; m; m = NEXT(m), n++ );
-         if ( n <= nsep ) {
-                 muldc(CO,p,(P)q,rp); return;
-         }
-         MKSTR(imul,"imulv");
-         t0 = get_rtime();
-         dp_dtov(p,&c);
-         sepvect(c,nsep,&cs);
-         r = (VECT *)CALLOC(nsep,sizeof(VECT *));
-         for ( i = 0, tn = dist, b = BDY(cs); i < ndist; i++, tn = NEXT(tn) ) {
-                 n0 = mknode(4,BDY(tn),imul,b[i],q);
-                 Pox_rpc(n0,&dmy);
-         }
-         t1 = get_rtime();
-         im_t_s += t1 - t0;
-         imulv(b[i],q,&r[i]);
-         t1 = get_rtime();
-         for ( i = 0, tn = dist; i < ndist; i++, tn = NEXT(tn) ) {
-                 MKNODE(n0,BDY(tn),0);
-                 Pox_pop_local(n0,&r[i]);
-                 if ( OID(r[i]) == O_ERR ) {
-                         printexpr(CO,(Obj)r[i]);
-                         error("dp_imul_d : aborted");
-                 }
-         }
-         t2 = get_rtime();
-         im_t_r += t2 - t1;
-         s = (Q *)CALLOC(n,sizeof(Q));
-         for ( i = j = 0; i < nsep; i++ ) {
-                 for ( k = 0, ri = r[i], l = ri->len; k < l; k++, j++ ) {
-                         s[j] = (Q)BDY(ri)[k];
-                 }
-         }
-         dp_vtod(s,p,rp);
- }
- void imulv(w,c,rp)
- VECT w;
- Q c;
- VECT *rp;
- {
-         int n,i;
-         VECT r;
-         n = w->len;
-         MKVECT(r,n); *rp = r;
-         for ( i = 0; i < n; i++ )
-                 mulq((Q)BDY(w)[i],(Q)c,(Q *)&BDY(r)[i]);
- }
- DP_pairs updpairs( d, g, t)
- DP_pairs d;
- NODE /* of index */ g;
- int t;
- {
          register DP_pairs d1, dd, nd;
-         struct oEGT tup0,tup1;
          int dl,dl1;
          if ( !g ) return d;
-         get_eg(&tup0);
          if ( !NoCriB && d ) {
                  dl = DPPlength(d);
                  d = criterion_B( d, t );
-                 dl -= DPPlength(d); NBP += dl;
+                 dl -= DPPlength(d); N_BP += dl;
          }
          d1 = newpairs( g, t );
          if ( NEXT(d1) ) {
-Line 2144  int t;
+Line 1946  int t;
 Line 2144  int t;
 Line 1946  int t;
                  dl1 = DPPlength(d1); NFP += (dl-dl1); dl = dl1;
          } else
                  dl = 1;
-         for ( dd = 0; d1; d1 = nd ) {
+         if ( !do_weyl )
-                 nd = NEXT(d1);
+                 for ( dd = 0; d1; d1 = nd ) {
-                 if ( !criterion_2( d1->dp1, d1->dp2 ) ) {
+                         nd = NEXT(d1);
-                         NEXT(d1) = dd;
+                         if ( !criterion_2( d1->dp1, d1->dp2 ) ) {
-                         dd = d1;
+                                 NEXT(d1) = dd;
+                                 dd = d1;
+                         }
                  }
-         }
+         else
+                 dd = d1;
          dl1 = DPPlength(dd); NDP += (dl-dl1);
-         get_eg(&tup1);
-         add_eg(&eg_up,&tup0,&tup1);
          if ( !(nd = d) ) return dd;
          while ( nd = NEXT(d1 = nd) ) ;
          NEXT(d1) = dd;
          return d;
  }
- DP_pairs newpairs( g, t )
+ DP_pairs newpairs( NODE /* of index */ g, int t )
- NODE /* of index */ g;
- register int t;
  {
          register NODE r;
          register DL tdl = psh[t];
-Line 2178  register int t;
+Line 1979  register int t;
 Line 2178  register int t;
 Line 1979  register int t;
                  last = p;
                  dp = p->dp1 = (int)BDY(r);  p->dp2 = t;
                  p->lcm = lcm_of_DL(CNVars, dl = psh[dp], tdl, (DL)0 );
-                 p->sugar = (ts > (s = pss[dp] - dl->td) ? ts : s) + p->lcm->td;
+ #if 0
+                 if ( do_weyl )
+                         p->sugar = dl_weyl_weight(p->lcm);
+                 else
+ #endif
+                         p->sugar = (ts > (s = pss[dp] - dl->td) ? ts : s) + p->lcm->td;
          }
          return last;
  }
- DP_pairs criterion_B( d, s )
+ DP_pairs criterion_B( DP_pairs d, int s )
- register DP_pairs d;
- int s;
  {
          register DP_pairs dd, p;
          register DL tij, t = psh[s], dltmp;
-Line 2208  int s;
+Line 2012  int s;
 Line 2208  int s;
 Line 2012  int s;
          return dd;
  }
- DP_pairs criterion_M( d1 )
+ DP_pairs criterion_M( DP_pairs d1 )
- DP_pairs d1;
  {
          register DP_pairs dd, e, d3, d2, p;
          register DL itdl, jtdl;
-Line 2251  DP_pairs d1;
+Line 2054  DP_pairs d1;
 Line 2251  DP_pairs d1;
 Line 2054  DP_pairs d1;
          return dd;
  }
- static DP_pairs collect_pairs_of_hdlcm( d1, prest )
+ static DP_pairs collect_pairs_of_hdlcm( DP_pairs d1, DP_pairs *prest )
- DP_pairs d1, *prest;
  {
          register DP_pairs w, p, r, s;
          register DL ti;
-Line 2276  DP_pairs d1, *prest;
+Line 2078  DP_pairs d1, *prest;
 Line 2276  DP_pairs d1, *prest;
 Line 2078  DP_pairs d1, *prest;
          return w;
  }
- int criterion_2( dp1, dp2 )
+ int criterion_2( int dp1, int dp2 )
- int dp1, dp2;
  {
          register int i, *d1, *d2;
-Line 2287  int dp1, dp2;
+Line 2088  int dp1, dp2;
 Line 2287  int dp1, dp2;
 Line 2088  int dp1, dp2;
          return 1;
  }
- DP_pairs criterion_F( d1 )
+ DP_pairs criterion_F( DP_pairs d1 )
- DP_pairs d1;
  {
          DP_pairs rest, head;
          register DP_pairs last, p, r, w;
-Line 2297  DP_pairs d1;
+Line 2097  DP_pairs d1;
 Line 2297  DP_pairs d1;
 Line 2097  DP_pairs d1;
          for ( head = last = 0, p = d1; NEXT(p); ) {
                  s = (r = w = collect_pairs_of_hdlcm( p, &rest ))->sugar;
                  while ( w = NEXT(w) )
-                         if ( criterion_2( w->dp1, w->dp2 ) ) {
+                         if ( !do_weyl && criterion_2( w->dp1, w->dp2 ) ) {
                                  r = w;
                                  break;
                          } else if ( w->sugar < s ) s = (r = w)->sugar;
-Line 2311  DP_pairs d1;
+Line 2111  DP_pairs d1;
 Line 2311  DP_pairs d1;
 Line 2111  DP_pairs d1;
          return head;
  }
- NODE updbase(g,t)
+ NODE updbase(NODE g,int t)
- NODE g;
- int t;
  {
          g = remove_reducibles(g,t);
          g = append_one(g,t);
          return g;
  }
- NODE /* of index */ remove_reducibles( nd, newdp )
+ NODE /* of index */ remove_reducibles(NODE /* of index */ nd, int newdp )
- NODE /* of index */ nd;
- int newdp;
  {
          register DL dl, dln;
          register NODE last, p, head;
-Line 2343  int newdp;
+Line 2139  int newdp;
 Line 2343  int newdp;
 Line 2139  int newdp;
          return head;
  }
- int dl_redble( dl1, dl2 )
+ int dl_redble(DL dl1,DL dl2)
- DL dl1, dl2;
  {
          register int n, *d1, *d2;
-Line 2353  DL dl1, dl2;
+Line 2148  DL dl1, dl2;
 Line 2353  DL dl1, dl2;
 Line 2148  DL dl1, dl2;
          return 1;
  }
- int gbcheck(f)
+ #if 0
- NODE f;
+ int dl_weyl_weight(DL dl)
  {
+         int n,w,i;
+         n = CNVars/2;
+         for ( i = 0, w = 0; i < n; i++ )
+                 w += (-dl->d[i]+dl->d[n+i]);
+         return w;
+ }
+ #endif
+ int gbcheck(NODE f)
+ {
          int i;
          NODE r,g,gall;
          DP_pairs d,l;
-Line 2370  NODE f;
+Line 2176  NODE f;
 Line 2370  NODE f;
 Line 2176  NODE f;
                  g = updbase(g,i);
                  gall = append_one(gall,i);
          }
-         if ( Print || PrintShort ) {
+         if ( DP_Print || DP_PrintShort ) {
                  fprintf(asir_out,"gbcheck total %d pairs\n",DPPlength(d)); fflush(asir_out);
          }
          while ( d ) {
                  l = d; d = NEXT(d);
                  get_eg(&tmp0);
-                 dp_load(l->dp1,&dp1); dp_load(l->dp2,&dp2); dp_sp(dp1,dp2,&h);
+                 dp_load(l->dp1,&dp1); dp_load(l->dp2,&dp2);
+                 dp_sp(dp1,dp2,&h);
+ /* fprintf(stderr,"{%d,%d}",l->dp1,l->dp2); */
                  _dp_nf(gall,h,ps,1,&nf);
                  get_eg(&tmp1); add_eg(&eg_gc,&tmp0,&tmp1);
-                 if ( Print || PrintShort ) {
+                 if ( DP_Print || DP_PrintShort ) {
                          fprintf(asir_out,"."); fflush(asir_out);
                  }
                  if ( nf )
                          return 0;
          }
-         if ( Print || PrintShort )
+         if ( DP_Print || DP_PrintShort )
                  fprintf(asir_out,"\n");
          return 1;
  }
- int membercheck(f,x)
+ void gbcheck_list(NODE f,int n,VECT *gp,LIST *pp)
- NODE f,x;
  {
+         int i;
+         NODE r,g,gall,u,u0,t;
+         VECT vect;
+         LIST pair;
+         DP_pairs d,l;
+         Q q1,q2;
+         /* we need the following settings */
+         NVars = CNVars = n;
+         setup_arrays(f,0,&r);
+         for ( gall = g = 0, d = 0; r; r = NEXT(r) ) {
+                 i = (int)BDY(r);
+                 d = updpairs(d,g,i);
+                 g = updbase(g,i);
+                 gall = append_one(gall,i);
+         }
+         NEWVECT(vect); vect->len = psn; vect->body = (pointer)ps;
+         *gp = vect;
+         for ( u0 = 0, l = d; l; l = NEXT(l) ) {
+                 NEXTNODE(u0,u);
+                 STOQ(l->dp1,q1);
+                 STOQ(l->dp2,q2);
+                 t = mknode(2,q1,q2);
+                 MKLIST(pair,t);
+                 BDY(u) = (pointer)pair;
+         }
+         if ( u0 )
+                 NEXT(u) = 0;
+         MKLIST(*pp,u0);
+ }
+ int membercheck(NODE f,NODE x)
+ {
          DP g;
          struct oEGT tmp0,tmp1;
          if ( NoMC )
                  return 1;
-         if ( Print || PrintShort ) {
+         if ( DP_Print || DP_PrintShort ) {
                  fprintf(asir_out,"membercheck\n"); fflush(asir_out);
          }
          for ( ; f; f = NEXT(f) ) {
                  get_eg(&tmp0);
                  _dp_nf(x,(DP)BDY(f),ps,1,&g);
                  get_eg(&tmp1); add_eg(&eg_mc,&tmp0,&tmp1);
-                 if ( Print ) {
+                 if ( DP_Print ) {
                          print_split_eg(&tmp0,&tmp1); fflush(asir_out);
-                 } else if ( PrintShort ) {
+                 } else if ( DP_PrintShort ) {
                          fprintf(asir_out,"."); fflush(asir_out);
                  }
                  if ( g )
                          return 0;
          }
-         if ( Print || PrintShort )
+         if ( DP_Print || DP_PrintShort )
                  fprintf(asir_out,"\n");
          return 1;
  }
- void dp_set_flag(name,value)
+ void dp_set_flag(Obj name,Obj value)
- Obj name,value;
  {
          char *n;
          int v;
+         Q ratio;
          if ( OID(name) != O_STR )
                  return;
-Line 2433  Obj name,value;
+Line 2274  Obj name,value;
 Line 2433  Obj name,value;
 Line 2274  Obj name,value;
          if ( !strcmp(n,"Dist") ) {
                  Dist = (LIST)value; return;
          }
+         if ( !strcmp(n,"Content") ) {
+                 ratio = (Q)value;
+                 if ( ratio ) {
+                         DP_Multiple = BD(NM(ratio))[0];
+                         Denominator = INT(ratio) ? 1 : BD(DN(ratio))[0];
+                 } else {
+                         DP_Multiple = 0;
+                         Denominator = 1;
+                 }
+         }
          if ( value && OID(value) != O_N )
                  return;
          v = QTOS((Q)value);
-Line 2453  Obj name,value;
+Line 2304  Obj name,value;
 Line 2453  Obj name,value;
 Line 2304  Obj name,value;
          else if ( !strcmp(n,"ShowMag") )
                  ShowMag = v;
          else if ( !strcmp(n,"PrintShort") )
-                 PrintShort = v;
+                 DP_PrintShort = v;
          else if ( !strcmp(n,"Print") )
-                 Print = v;
+                 DP_Print = v;
+         else if ( !strcmp(n,"NFStat") )
+                 DP_NFStat = v;
          else if ( !strcmp(n,"Stat") )
                  Stat = v;
          else if ( !strcmp(n,"Reverse") )
                  Reverse = v;
-         else if ( !strcmp(n,"InterReduce") )
-                 InterReduce = v;
          else if ( !strcmp(n,"Multiple") )
-                 Multiple = v;
+                 DP_Multiple = v;
          else if ( !strcmp(n,"Denominator") )
                  Denominator = v;
          else if ( !strcmp(n,"PtozpRA") )
                  PtozpRA = v;
+         else if ( !strcmp(n,"GenTrace") )
+                 GenTrace = v;
+         else if ( !strcmp(n,"OXCheck") )
+                 OXCheck = v;
+         else if ( !strcmp(n,"GenSyz") )
+                 GenSyz = v;
+         else if ( !strcmp(n,"OneZeroHomo") )
+                 OneZeroHomo = v;
+         else if ( !strcmp(n,"MaxDeg") )
+                 MaxDeg = v;
  }
- void dp_make_flaglist(list)
+ void dp_make_flaglist(LIST *list)
- LIST *list;
  {
-         Q v;
+         Q v,nm,dn;
          STRING name,path;
          NODE n,n1;
-         STOQ(Multiple,v); MKNODE(n,v,0); MKSTR(name,"Multiple"); MKNODE(n1,name,n); n = n1;
+ #if 0
+         STOQ(DP_Multiple,v); MKNODE(n,v,0); MKSTR(name,"DP_Multiple"); MKNODE(n1,name,n); n = n1;
          STOQ(Denominator,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Denominator"); MKNODE(n1,name,n); n = n1;
+ #else
+         if ( DP_Multiple ) {
+                 STOQ(DP_Multiple,nm); STOQ(Denominator,dn); divq(nm,dn,&v);
+         } else
+                 v = 0;
+         MKNODE(n,v,0); MKSTR(name,"Content"); MKNODE(n1,name,n); n = n1;
+ #endif
          MKNODE(n1,Dist,n); n = n1; MKSTR(name,"Dist"); MKNODE(n1,name,n); n = n1;
-         STOQ(InterReduce,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"InterReduce"); MKNODE(n1,name,n); n = n1;
          STOQ(Reverse,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Reverse"); MKNODE(n1,name,n); n = n1;
          STOQ(Stat,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Stat"); MKNODE(n1,name,n); n = n1;
-         STOQ(Print,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Print"); MKNODE(n1,name,n); n = n1;
+         STOQ(DP_Print,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Print"); MKNODE(n1,name,n); n = n1;
+         STOQ(DP_PrintShort,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"PrintShort"); MKNODE(n1,name,n); n = n1;
+         STOQ(DP_NFStat,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NFStat"); MKNODE(n1,name,n); n = n1;
+         STOQ(OXCheck,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"OXCheck"); MKNODE(n1,name,n); n = n1;
+         STOQ(GenTrace,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"GenTrace"); MKNODE(n1,name,n); n = n1;
+         STOQ(GenSyz,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"GenSyz"); MKNODE(n1,name,n); n = n1;
+         STOQ(MaxDeg,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"MaxDeg"); MKNODE(n1,name,n); n = n1;
+         STOQ(OneZeroHomo,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"OneZeroHomo"); MKNODE(n1,name,n); n = n1;
          STOQ(PtozpRA,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"PtozpRA"); MKNODE(n1,name,n); n = n1;
          STOQ(ShowMag,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"ShowMag"); MKNODE(n1,name,n); n = n1;
          STOQ(Top,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Top"); MKNODE(n1,name,n); n = n1;
-Line 2503  LIST *list;
+Line 2377  LIST *list;
 Line 2503  LIST *list;
 Line 2377  LIST *list;
  #define DELIM '/'
- #if defined(THINK_C)
+ void dp_save(int index,Obj p,char *prefix)
- #undef DELIM
- #define DELIM ':'
- #endif
- void dp_save(index,p)
- int index;
- DP p;
  {
          FILE *fp;
          char path[BUFSIZ];
-         sprintf(path,"%s%c%d",Demand,DELIM,index);
+         if ( prefix )
- #if defined(VISUAL) || defined(THINK_C)
+                 sprintf(path,"%s%c%s%d",Demand,DELIM,prefix,index);
+         else
+                 sprintf(path,"%s%c%d",Demand,DELIM,index);
          if ( !(fp = fopen(path,"wb") ) )
- #else
-         if ( !(fp = fopen(path,"w") ) )
- #endif
                  error("dp_save : cannot open a file");
-         savevl(fp,VC); saveobj(fp,(Obj)p); fclose(fp);
+         savevl(fp,VC); saveobj(fp,p); fclose(fp);
  }
- void dp_load(index,p)
+ void dp_load(int index,DP *p)
- int index;
- DP *p;
  {
          FILE *fp;
          char path[BUFSIZ];
-Line 2536  DP *p;
+Line 2400  DP *p;
 Line 2536  DP *p;
 Line 2400  DP *p;
                  *p = ps[index];
          else {
                  sprintf(path,"%s%c%d",Demand,DELIM,index);
- #if defined(VISUAL) || defined(THINK_C)
                  if ( !(fp = fopen(path,"rb") ) )
- #else
-                 if ( !(fp = fopen(path,"r") ) )
- #endif
                          error("dp_load : cannot open a file");
-                 skipvl(fp); loadobj(fp,(Obj *)p); fclose(fp);
+                 if ( PCoeffs )
+                         loadvl(fp);
+                 else
+                         skipvl(fp);
+                 loadobj(fp,(Obj *)p); fclose(fp);
          }
  }
- int dp_load_t(index,p)
+ int dp_load_t(int index,DP *p)
- int index;
- DP *p;
  {
          FILE *fp;
          char path[BUFSIZ];
          sprintf(path,"%s%c%d",Demand,DELIM,index);
- #if defined(VISUAL) || defined(THINK_C)
          if ( !(fp = fopen(path,"rb") ) )
- #else
-         if ( !(fp = fopen(path,"r") ) )
- #endif
                  return 0;
          else {
-                 skipvl(fp); loadobj(fp,(Obj *)p); fclose(fp); return 1;
+                 if ( PCoeffs )
+                         loadvl(fp);
+                 else
+                         skipvl(fp);
+                 loadobj(fp,(Obj *)p); fclose(fp); return 1;
          }
  }
  void init_stat() {
-         init_eg(&eg_up); init_eg(&eg_sp); init_eg(&eg_spm);
          init_eg(&eg_nf); init_eg(&eg_nfm); init_eg(&eg_znfm);
-         init_eg(&eg_pz); init_eg(&eg_np); init_eg(&eg_mp);
+         init_eg(&eg_pz); init_eg(&eg_np);
          init_eg(&eg_ra); init_eg(&eg_mc); init_eg(&eg_gc);
-         ZR = NZR = TP = NBP = NMP = NFP = NDP = 0;
+         ZR = NZR = TP = NMP = N_BP = NFP = NDP = 0;
  }
  void print_stat() {
-         if ( !Print && !Stat )
+         if ( !DP_Print && !Stat )
                  return;
-         print_eg("UP",&eg_up); print_eg("SP",&eg_sp); print_eg("SPM",&eg_spm);
          print_eg("NF",&eg_nf); print_eg("NFM",&eg_nfm); print_eg("ZNFM",&eg_znfm);
-         print_eg("PZ",&eg_pz); print_eg("NP",&eg_np); print_eg("MP",&eg_mp);
+         print_eg("PZ",&eg_pz); print_eg("NP",&eg_np);
          print_eg("RA",&eg_ra); print_eg("MC",&eg_mc); print_eg("GC",&eg_gc);
-         fprintf(asir_out,"T=%d,B=%d M=%d F=%d D=%d ZR=%d NZR=%d\n",TP,NBP,NMP,NFP,NDP,ZR,NZR);
+         fprintf(asir_out,"T=%d,B=%d M=%d F=%d D=%d ZR=%d NZR=%d\n",TP,N_BP,NMP,NFP,NDP,ZR,NZR);
  }
  /*
-  * Old codes
+  * dp_nf used in gb()
+  *
   */
- #if 0
+ double pz_t_e, pz_t_d, pz_t_d1, pz_t_c, im_t_s, im_t_r;
- void _dp_nf_ptozp(b,g,ps,full,multiple,rp)
- NODE b;
+ extern int GenTrace;
- DP g;
+ extern NODE TraceList;
- DP *ps;
+ extern int mpi_mag;
- int full,multiple;
- DP *rp;
+ void dp_mulc_d(DP p,P c,DP *r)
  {
-         DP u,p,d,s,t,dmy;
+         if ( Dist && BDY(Dist)
+                 && HMAG(p) > mpi_mag
+                 && p_mag((P)c) > mpi_mag ) {
+                 if ( DP_NFStat ) fprintf(asir_out,"~");
+                 dp_imul_d(p,(Q)c,r);
+         } else {
+                 if ( DP_NFStat ) fprintf(asir_out,"_");
+                 muldc(CO,p,c,r);
+         }
+ }
+ void _dp_nf(NODE b,DP g,DP *ps,int full,DP *rp)
+ {
+         DP u,p,d,s,t,mult;
+         P coef;
          NODE l;
          MP m,mr;
-         int i,n;
-         int hmag,denom;
          int sugar,psugar;
-         NODE dist;
-         int ndist;
-         int kara_bit;
-         extern int kara_mag;
          if ( !g ) {
                  *rp = 0; return;
          }
-         denom = Denominator?Denominator:1;
-         hmag = multiple*HMAG(g)/denom;
-         kara_bit = kara_mag*27; /* XXX */
-         if ( Dist ) {
-                 dist = BDY(Dist);
-                 ndist = length(dist);
-         }
          sugar = g->sugar;
          for ( d = 0; g; ) {
                  for ( u = 0, l = b; l; l = NEXT(l) ) {
                          if ( dl_redble(BDY(g)->dl,psh[(int)BDY(l)]) ) {
                                  dp_load((int)BDY(l),&p);
-                                 dp_red(d,g,p,&t,&u,&dmy);
+                                 /* t+u = coef*(d+g) - mult*p (t = coef*d) */
+                                 dp_red(d,g,p,&t,&u,&coef,&mult);
                                  psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
                                  sugar = MAX(sugar,psugar);
+                                 if ( GenTrace ) {
+                                         LIST hist;
+                                         Q cq;
+                                         NODE node,node0;
+                                         STOQ((int)BDY(l),cq);
+                                         node0 = mknode(4,coef,cq,mult,ONE);
+                                         MKLIST(hist,node0);
+                                         MKNODE(node,hist,TraceList); TraceList = node;
+                                 }
                                  if ( !u ) {
                                          if ( d )
                                                  d->sugar = sugar;
-Line 2633  DP *rp;
+Line 2506  DP *rp;
 Line 2633  DP *rp;
 Line 2506  DP *rp;
                                  break;
                          }
                  }
-                 if ( u ) {
+                 if ( u )
                          g = u;
-                         if ( d ) {
-                                 if ( HMAG(d) > hmag ) {
-                                         if ( Dist && HMAG(g) > kara_bit )
-                                                 dp_ptozp2_d(dist,ndist,d,g,&t,&u);
-                                         else
-                                                 dp_ptozp2(d,g,&t,&u);
-                                         d = t; g = u;
-                                         hmag = multiple*HMAG(d)/denom;
-                                 }
-                         } else {
-                                 if ( HMAG(g) > hmag ) {
- #if INET
-                                         if ( Dist && HMAG(g) > kara_bit ) {
-                                                 dp_ptozp_d(dist,ndist,g,&t);
-                                         } else
- #endif
-                                                 dp_ptozp(g,&t);
-                                         g = t;
-                                         hmag = multiple*HMAG(g)/denom;
-                                 }
-                         }
-                 }
                  else if ( !full ) {
                          if ( g ) {
                                  MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
-Line 2674  DP *rp;
+Line 2525  DP *rp;
 Line 2674  DP *rp;
 Line 2525  DP *rp;
          *rp = d;
  }
- int criterion_2(dp1,dp2)
+ void _dp_nf_z(NODE b,DP g,DP *ps,int full,int multiple,DP *r)
  {
-         DP g1,g2,g,s1,s2;
+         DP u,dp,rp,t,t1,red,shift;
+         Q dc,rc,dcq,rcq,cont,hr,hred,cr,cred,mcred,c,gcd,cq;
+         NODE l;
+         int hmag,denom;
+         int sugar,psugar;
+         STRING imul;
+         double t_0,tt,t_p,t_m,t_g,t_a;
+         LIST hist;
+         NODE node;
+         Q rcred,mrcred;
-         monomial_gcd(ps[dp1],&g1); monomial_gcd(ps[dp2],&g2);
+         if ( !g ) {
-         dp_gcd(g1,g2,&g);
+                 *r = 0; return;
-         dp_subd(ps[dp1],g,&s1); dp_subd(ps[dp2],g,&s2);
+         }
-         return _criterion_2(s1,s2);
+         pz_t_e = pz_t_d = pz_t_d1 = pz_t_c = 0;
- }
+         t_p = t_m = t_g = t_a = 0;
- int _criterion_2( dp1, dp2 )
+         denom = Denominator?Denominator:1;
- DP dp1, dp2;
+         hmag = multiple*HMAG(g)/denom;
- {
+         sugar = g->sugar;
-         register int i, *d1, *d2;
-         d1 = BDY(dp1)->dl->d; d2 = BDY(dp2)->dl->d;
+         dc = 0; dp = 0; rc = ONE; rp = g;
-         for ( i = CNVars; --i >= 0; d1++, d2++ )
+         MKSTR(imul,"dp_imul_index");
-                 if ( (*d1 <= *d2 ? *d1 : *d2) > 0  ) return 0;
-         return 1;
+         /* g = dc*dp+rc*rp */
+         for ( ; rp; ) {
+                 for ( u = 0, l = b; l; l = NEXT(l) ) {
+                         if ( dl_redble(BDY(rp)->dl,psh[(int)BDY(l)]) ) {
+                                 t_0 = get_rtime();
+                                 dp_load((int)BDY(l),&red);
+                                 hr = (Q)BDY(rp)->c; hred = (Q)BDY(red)->c;
+                                 igcd_cofactor((Q)BDY(rp)->c,(Q)BDY(red)->c,&gcd,&cred,&cr);
+                                 tt = get_rtime(); t_p += tt-t_0;
+                                 dp_subd(rp,red,&shift);
+                                 dp_mulc_d(rp,(P)cr,&t);
+                                 chsgnp((P)cred,(P *)&mcred);
+                                 dp_mulc_d(red,(P)mcred,&t1);
+                                 muld(CO,shift,t1,&t1);
+                                 addd(CO,t,t1,&u);
+                                 t_m += get_rtime()-tt;
+                                 psugar = (BDY(rp)->dl->td - BDY(red)->dl->td) + red->sugar;
+                                 sugar = MAX(sugar,psugar);
+                                 if ( GenTrace ) {
+                                         /* u = cr*rp + (-cred)*shift*red */
+                                         STOQ((int)BDY(l),cq);
+                                         node = mknode(4,cr,cq,NULLP,NULLP);
+                                         mulq(cred,rc,&rcred);
+                                         chsgnnum((Num)rcred,(Num *)&mrcred);
+                                         muldc(CO,shift,(P)mrcred,(DP *)&ARG2(node));
+                                         MKLIST(hist,node);
+                                 }
+                                 if ( !u ) {
+                                         if ( dp )
+                                                 dp->sugar = sugar;
+                                         *r = dp;
+                                         if ( GenTrace ) {
+                                                 ARG3(BDY(hist)) = ONE;
+                                                 MKNODE(node,hist,TraceList); TraceList = node;
+                                         }
+                                         goto final;
+                                 }
+                                 break;
+                         }
+                 }
+                 if ( u ) {
+                         if ( multiple && HMAG(u) > hmag ) {
+                                 t_0 = get_rtime();
+                                 dp_ptozp_d(u,&rp);
+                                 tt = get_rtime(); t_g += tt-t_0;
+                                 divsq((Q)BDY(u)->c,(Q)BDY(rp)->c,&cont);
+                                 if ( !dp_fcoeffs && DP_NFStat ) {
+                                         fprintf(asir_out,
+                                                 "(%d)",p_mag((P)cont)*100/p_mag((P)BDY(u)->c));
+                                         fflush(asir_out);
+                                 }
+                                 mulq(cr,dc,&dcq); mulq(cont,rc,&rcq);
+                                 igcd_cofactor(dcq,rcq,&gcd,&dc,&rc);
+                                 t_a = get_rtime()-tt;
+                                 hmag = multiple*HMAG(rp)/denom;
+                                 if ( GenTrace ) {
+                                         ARG3(BDY(hist)) = (pointer)gcd;
+                                         MKNODE(node,hist,TraceList); TraceList = node;
+                                 }
+                         } else {
+                                 rp = u;
+                                 t_0 = get_rtime();
+                                 mulq(cr,dc,&dc);
+                                 t_a += get_rtime()-t_0;
+                                 if ( GenTrace ) {
+                                         ARG3(BDY(hist)) = (pointer)ONE;
+                                         MKNODE(node,hist,TraceList); TraceList = node;
+                                 }
+                         }
+                 } else if ( !full ) {
+                         if ( rp ) {
+                                 MKDP(rp->nv,BDY(rp),t); t->sugar = sugar; rp = t;
+                         }
+                         *r = rp;
+                         goto final;
+                 } else {
+                         t_0 = get_rtime();
+                         mulq((Q)BDY(rp)->c,rc,&c);
+                         igcd_cofactor(dc,c,&dc,&dcq,&cq);
+                         muldc(CO,dp,(P)dcq,&t);
+                         dp_hm(rp,&t1); BDY(t1)->c = (P)cq;  addd(CO,t,t1,&dp);
+                         dp_rest(rp,&rp);
+                         t_a += get_rtime()-t_0;
+                 }
+         }
+         if ( GenTrace ) {
+                 mulq(ARG3(BDY((LIST)BDY(TraceList))),dc,&cq);
+                 ARG3(BDY((LIST)BDY(TraceList))) = (pointer)cq;
+         }
+         if ( dp )
+                 dp->sugar = sugar;
+         *r = dp;
+ final:
+         if ( DP_NFStat )
+                 fprintf(asir_out,
+                         "(%.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g)",
+                         t_p,t_m,t_g,t_a,
+                         pz_t_e, pz_t_d, pz_t_d1, pz_t_c);
  }
- void dp_gcd(p1,p2,rp)
+ void imulv();
- DP p1,p2;
- DP *rp;
+ void dp_imul_d(DP p,Q q,DP *rp)
  {
-         int i,n,td;
+         int nsep,ndist,i,j,k,l,n;
-         DL d1,d2,d;
+         double t0,t1,t2;
+         Q *s;
+         pointer *b;
+         VECT c,cs,ri;
+         VECT *r;
          MP m;
-         DP s;
+         NODE tn,dist,n0;
+         Obj obj;
+         STRING imul;
+         extern LIST Dist;
-         n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
+         if ( !p || !q ) {
-         NEWDL(d,n);
+                 *rp = 0; return;
-         for ( i = 0, td = 0; i < n; i++ ) {
-                 d->d[i] = MIN(d1->d[i],d2->d[i]);
-                 td += d->d[i];
          }
-         d->td = td;
+         dist = BDY(Dist);
-         NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0; MKDP(n,m,s); s->sugar = d->td;
+         for ( tn = dist, ndist = 0; tn; tn = NEXT(tn), ndist++ );
-         *rp = s;
+         nsep = ndist + 1;
+         for ( m = BDY(p), n = 0; m; m = NEXT(m), n++ );
+         if ( n <= nsep ) {
+                 muldc(CO,p,(P)q,rp); return;
+         }
+         MKSTR(imul,"imulv");
+         t0 = get_rtime();
+         dp_dtov(p,&c);
+         sepvect(c,nsep,&cs);
+         r = (VECT *)CALLOC(nsep,sizeof(VECT *));
+         for ( i = 0, tn = dist, b = BDY(cs); i < ndist; i++, tn = NEXT(tn) ) {
+                 n0 = mknode(4,BDY(tn),imul,b[i],q);
+                 Pox_rpc(n0,&obj);
+         }
+         t1 = get_rtime();
+         im_t_s += t1 - t0;
+         imulv(b[i],q,&r[i]);
+         t1 = get_rtime();
+         for ( i = 0, tn = dist; i < ndist; i++, tn = NEXT(tn) ) {
+                 MKNODE(n0,BDY(tn),0);
+                 Pox_pop_local(n0,&obj); r[i] = (VECT)obj;
+                 if ( OID(r[i]) == O_ERR ) {
+                         printexpr(CO,(Obj)r[i]);
+                         error("dp_imul_d : aborted");
+                 }
+         }
+         t2 = get_rtime();
+         im_t_r += t2 - t1;
+         s = (Q *)CALLOC(n,sizeof(Q));
+         for ( i = j = 0; i < nsep; i++ ) {
+                 for ( k = 0, ri = r[i], l = ri->len; k < l; k++, j++ ) {
+                         s[j] = (Q)BDY(ri)[k];
+                 }
+         }
+         dp_vtod(s,p,rp);
  }
- void monomial_gcd(p,rp)
+ void imulv(VECT w,Q c,VECT *rp)
- DP p;
- DP *rp;
  {
-         int n,i,td;
+         int n,i;
-         DL d,d1;
+         VECT r;
-         MP m;
-         DP s;
-         n = p->nv; m = BDY(p); d = m->dl;
+         n = w->len;
-         NEWDL(d1,n);
+         MKVECT(r,n); *rp = r;
          for ( i = 0; i < n; i++ )
-                 d1->d[i] = d->d[i];
+                 mulq((Q)BDY(w)[i],(Q)c,(Q *)&BDY(r)[i]);
-         for ( m = NEXT(m); m; m = NEXT(m) ) {
+ }
-                 d = m->dl;
-                 for ( i = 0; i < n; i++ )
+ void dptoca(DP p,unsigned int **rp)
-                         d1->d[i] = MIN(d1->d[i],d->d[i]);
+ {
+         int i;
+         MP m;
+         unsigned int *r;
+         if ( !p )
+                 *rp = 0;
+         else {
+                 for ( m = BDY(p), i = 0; m; m = NEXT(m), i++ );
+                 *rp = r = (unsigned int *)MALLOC_ATOMIC(i*sizeof(unsigned int));
+                 for ( m = BDY(p), i = 0; m; m = NEXT(m), i++ )
+                         r[i] = ITOS(C(m));
          }
-         for ( i = 0, td = 0; i < n; i++ )
-                 td += d1->d[i];
-         NEWMP(m); m->dl = d1; m->c = (P)ONE; NEXT(m) = 0; MKDP(n,m,s); s->sugar = d->td;
-         *rp = s;
  }
- #endif

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>