===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/lib/primdec_mod,v
retrieving revision 1.10
retrieving revision 1.15
diff -u -p -r1.10 -r1.15
--- OpenXM_contrib2/asir2000/lib/primdec_mod	2003/05/07 06:26:51	1.10
+++ OpenXM_contrib2/asir2000/lib/primdec_mod	2006/02/24 01:15:56	1.15
@@ -1,4 +1,4 @@
-/* $OpenXM: OpenXM_contrib2/asir2000/lib/primdec_mod,v 1.9 2003/04/24 07:54:15 noro Exp $ */
+/* $OpenXM: OpenXM_contrib2/asir2000/lib/primdec_mod,v 1.14 2004/07/30 02:24:11 noro Exp $ */
 
 extern Hom,GBTime$
 extern DIVLIST,INTIDEAL,ORIGINAL,ORIGINALDIMENSION,STOP,Trials,REM$
@@ -6,11 +6,12 @@ extern T_GRF,T_INT,T_PD,T_MP$
 extern BuchbergerMinipoly,PartialDecompByLex,ParallelMinipoly$
 extern B_Win,D_Win$
 extern COMMONCHECK_SF,CID_SF$
-extern LIBRARY_GR_LOADED$
-extern LIBRARY_FFF_LOADED$
 
-if(!LIBRARY_FFF_LOADED) load("fff"); else ; LIBRARY_FFF_LOADED = 1$
-if(!LIBRARY_GR_LOADED) load("gr"); else ; LIBRARY_GR_LOADED = 1$
+if (!module_definedp("fff")) load("fff"); else $
+if (!module_definedp("gr")) load("gr"); else $
+module primdec_mod $
+  /* Empty for now. It will be used in a future. */
+endmodule $
 
 /*==============================================*/
 /*  prime decomposition of ideals over 		*/
@@ -1973,11 +1974,13 @@ def contraction(P,V,W)
 	/* This procedure is called by zeroprimedecomposition.	*/
 	/* So, P is supposed to be a GB w.r.t. DRL.		*/
 
+	Ord0 = dp_ord();
 	Ord=0;
 	YSet=setminus(W,V);
 
 	Ord1 = [[Ord,length(V)],[0,length(YSet)]];
-	GP1 = dp_gr_f_main(P,W,Hom,Ord1);
+	W1 = append(V,YSet);
+	GP1 = dp_gr_f_main(P,W1,Hom,Ord1);
 
 	Factor = extcont_factor(GP1,V,Ord);
 	for ( F = 1, T = Factor; T != []; T = cdr(T) )
@@ -1989,6 +1992,7 @@ def contraction(P,V,W)
 	for ( T = G; T != []; T = cdr(T) )
 		if ( !member(Vt,vars(car(T))) )
 			R = cons(car(T),R);
+	dp_ord(Ord0);
 	return [R,F];
 	}
 
@@ -3158,7 +3162,7 @@ def ideal_uniq(L) /* sub procedure of welldec and norm
 			R = append(R,[L[I]]);
 		else {
 			for (J = 0; J < length(R); J++)
-				if ( gb_comp(L[I],R[J]) )
+				if ( gb_comp_old(L[I],R[J]) )
 					break;
 			if ( J == length(R) )
 				R = append(R,[L[I]]);
@@ -3174,7 +3178,7 @@ def ideal_uniq_by_first(L) /* sub procedure of welldec
 			R = append(R,[L[I]]);
 		else {
 			for (J = 0; J < length(R); J++)
-				if ( gb_comp(L[I][0],R[J][0]) )
+				if ( gb_comp_old(L[I][0],R[J][0]) )
 					break;
 			if ( J == length(R) )
 				R = append(R,[L[I]]);
@@ -3235,7 +3239,7 @@ def gr_fctr_sf(FL,VL,Ord)
 	for (TP = [],I = 0; I<length(FL); I++ ) {
 		F = FL[I];
 		SF = idealsqfr_sf(F);
-		if ( !gb_comp(F,SF) ) 
+		if ( !gb_comp_old(F,SF) ) 
 			F = dp_gr_f_main(SF,VL,0,Ord);
 		CID_SF=[1];
 		SP = gr_fctr_sub_sf(F,VL,Ord);
@@ -3259,7 +3263,7 @@ def gr_fctr_sub_sf(G,VL,Ord)
 				W = cons(FL[J][0],G);
 				NG = dp_gr_f_main(W,VL,0,Ord);
 				TNG = idealsqfr_sf(NG);
-				if ( !gb_comp(NG,TNG) )
+				if ( !gb_comp_old(NG,TNG) )
 					NG = dp_gr_f_main(TNG,VL,0,Ord);
 				if ( !inclusion_test(CID_SF,NG,VL,Ord) ) {
 					DG = gr_fctr_sub_sf(NG,VL,Ord);
@@ -3277,5 +3281,21 @@ def gr_fctr_sub_sf(G,VL,Ord)
 	if (I == length(G))
 		RL = append([G],RL);
 	return RL;
+}
+
+def gb_comp_old(A,B)
+{
+	LA = length(A);
+	LB = length(B);
+	if ( LA != LB )
+		return 0;
+	A = newvect(LA,A);
+	B = newvect(LB,B);
+	A1 = qsort(A);
+	B1 = qsort(B);
+	for ( I = 0; I < LA; I++ )
+		if ( A1[I] != B1[I] && A1[I] != -B1[I] )
+			break;
+	return I == LA ? 1 : 0;
 }
 end$