===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/gr.c,v
retrieving revision 1.16
retrieving revision 1.21
diff -u -p -r1.16 -r1.21
--- OpenXM_contrib2/asir2000/builtin/gr.c	2000/12/08 06:43:09	1.16
+++ OpenXM_contrib2/asir2000/builtin/gr.c	2001/09/04 08:48:19	1.21
@@ -45,7 +45,7 @@
  * 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.15 2000/12/08 04:35:30 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/gr.c,v 1.20 2001/07/23 05:03:22 noro Exp $ 
 */
 #include "ca.h"
 #include "parse.h"
@@ -106,7 +106,7 @@ DP_pairs criterion_B(DP_pairs,int);
 DP_pairs newpairs(NODE,int);
 DP_pairs updpairs(DP_pairs,NODE,int);
 void _dp_nf(NODE,DP,DP *,int,DP *);
-void _dp_nf_ptozp(NODE,DP,DP *,int,int,DP *);
+void _dp_nf_z(NODE,DP,DP *,int,int,DP *);
 NODE gb_mod(NODE,int);
 NODE gbd(NODE,int,NODE,NODE);
 NODE gb(NODE,int,NODE);
@@ -135,8 +135,8 @@ 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_gr_main(LIST,LIST,Num,int,int,struct order_spec *,LIST *);
+void dp_f4_main(LIST,LIST,int,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 *);
@@ -257,10 +257,10 @@ NODE f;
 	printf("\n");
 }
 
-void dp_gr_main(f,v,homo,modular,ord,rp)
+void dp_gr_main(f,v,homo,modular,field,ord,rp)
 LIST f,v;
 Num homo;
-int modular;
+int modular,field;
 struct order_spec *ord;
 LIST *rp;
 {
@@ -269,7 +269,7 @@ LIST *rp;
 	VL fv,vv,vc;
 	NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
 
-	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;
@@ -296,7 +296,7 @@ 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);
@@ -326,7 +326,7 @@ 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++ ) {
@@ -355,6 +355,7 @@ LIST *rp;
 	VL fv,vv,vc;
 	NODE fd,fd0,r,r0,t,x,s,xx;
 	DP a,b,c;
+extern struct oEGT eg_red_mod;
 
 	get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
 	NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
@@ -392,7 +393,9 @@ LIST *rp;
 	if ( homo ) {
 		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;
@@ -411,8 +414,9 @@ LIST *rp;
 	MKLIST(*rp,r0);
 }
 
-void dp_f4_main(f,v,ord,rp)
+void dp_f4_main(f,v,field,ord,rp)
 LIST f,v;
+int field;
 struct order_spec *ord;
 LIST *rp;
 {
@@ -421,7 +425,7 @@ LIST *rp;
 	VL fv,vv,vc;
 	NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
 
-	dp_fcoeffs = 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;
@@ -728,11 +732,13 @@ int m;
 			for ( j = 0; j < spcol; j++ )
 				if ( spmat[i][j] )
 					nonzero++;
-		if ( DP_Print )
+		if ( DP_Print && nsp )
 			fprintf(asir_out,"spmat : %d x %d (nonzero=%f%%)...",
 				nsp,spcol,((double)nonzero*100)/(nsp*spcol));
-		rank = generic_gauss_elim_mod(spmat,nsp,spcol,m,colstat);
-
+		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);
 
@@ -897,7 +903,11 @@ int m;
 	int i;
 	NODE s,s0,f0;
 
+#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));
@@ -1407,10 +1417,10 @@ NODE subst;
 				new_sugar = h->sugar;
 			get_eg(&tnf0);
 			t_0 = get_rtime();
-			if ( PCoeffs )
+			if ( PCoeffs || dp_fcoeffs )
 				_dp_nf(gall,h,ps,!Top,&nf);
 			else
-				_dp_nf_ptozp(gall,h,ps,!Top,DP_Multiple,&nf);
+				_dp_nf_z(gall,h,ps,!Top,DP_Multiple,&nf);
 			if ( DP_Print )
 				fprintf(asir_out,"(%.3g)",get_rtime()-t_0);
 			get_eg(&tnf1); add_eg(&eg_nf,&tnf0,&tnf1);
@@ -1808,7 +1818,9 @@ NODE f;
 	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 ( DP_Print || DP_PrintShort ) {
@@ -1919,6 +1931,7 @@ LIST *list;
 	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(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;
@@ -2096,7 +2109,7 @@ DP *rp;
 	*rp = d;
 }
 
-void _dp_nf_ptozp(b,g,ps,full,multiple,r)
+void _dp_nf_z(b,g,ps,full,multiple,r)
 NODE b;
 DP g;
 DP *ps;