===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/engine/nd.c,v
retrieving revision 1.125
retrieving revision 1.127
diff -u -p -r1.125 -r1.127
--- OpenXM_contrib2/asir2000/engine/nd.c	2005/02/09 08:32:32	1.125
+++ OpenXM_contrib2/asir2000/engine/nd.c	2005/08/03 05:01:01	1.127
@@ -1,4 +1,4 @@
-/* $OpenXM: OpenXM_contrib2/asir2000/engine/nd.c,v 1.124 2005/02/09 07:58:43 noro Exp $ */
+/* $OpenXM: OpenXM_contrib2/asir2000/engine/nd.c,v 1.126 2005/02/09 14:30:47 noro Exp $ */
 
 #include "nd.h"
 
@@ -2414,6 +2414,86 @@ void nd_gr(LIST f,LIST v,int m,int f4,struct order_spe
 #endif
 }
 
+void nd_gr_postproc(LIST f,LIST v,int m,struct order_spec *ord,int do_check,LIST *rp)
+{
+	VL tv,fv,vv,vc,av;
+	NODE fd,fd0,r,r0,t,x,s,xx,alist;
+	int e,max,nvar,i;
+	NDV b;
+	int ishomo,nalg;
+	Alg alpha,dp;
+	P p;
+	LIST f1,f2;
+	Obj obj;
+	NumberField nf;
+	struct order_spec *ord1;
+
+	get_vars((Obj)f,&fv); pltovl(v,&vv);
+	for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
+	switch ( ord->id ) {
+		case 1:
+			if ( ord->nv != nvar )
+				error("nd_check : invalid order specification");
+			break;
+		default:
+			break;
+	}
+	nd_nalg = 0;
+	av = 0;
+	if ( !m ) {
+		get_algtree((Obj)f,&av);
+		for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
+		nd_ntrans = nvar;
+		nd_nalg = nalg;
+		/* #i -> t#i */
+		if ( nalg ) {
+			preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
+			ord = ord1;
+			f = f1;
+		}
+		nvar += nalg;
+	}
+	nd_init_ord(ord);
+	for ( t = BDY(f), max = 0; t; t = NEXT(t) )
+		for ( tv = vv; tv; tv = NEXT(tv) ) {
+			e = getdeg(tv->v,(P)BDY(t));
+			max = MAX(e,max);
+		}
+	nd_setup_parameters(nvar,max);
+	ishomo = 1;
+	for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+		b = (pointer)ptondv(CO,vv,(P)BDY(t));
+		if ( ishomo )
+			ishomo = ishomo && ndv_ishomo(b);
+		if ( m ) ndv_mod(m,b);
+		if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
+	}
+	if ( fd0 ) NEXT(fd) = 0;
+	ndv_setup(m,0,fd0);
+	for ( x = 0, i = 0; i < nd_psn; i++ )
+		x = update_base(x,i);
+	if ( do_check ) {
+		x = nd_gb(m,ishomo,1);
+		if ( !x ) {
+			*rp = 0;
+			return;
+		}
+	} else {
+		for ( t = x; t; t = NEXT(t) )
+			BDY(t) = (pointer)nd_ps[(int)BDY(t)];
+	}
+	x = ndv_reducebase(x);
+	x = ndv_reduceall(m,x);
+	for ( r0 = 0, t = x; t; t = NEXT(t) ) {
+		NEXTNODE(r0,r); 
+		BDY(r) = ndvtop(m,CO,vv,BDY(t));
+	}
+	if ( r0 ) NEXT(r) = 0;
+	if ( nalg )
+		r0 = postprocess_algcoef(av,alist,r0);
+	MKLIST(*rp,r0);
+}
+
 void nd_gr_trace(LIST f,LIST v,int trace,int homo,struct order_spec *ord,LIST *rp)
 {
 	VL tv,fv,vv,vc,av;
@@ -5098,7 +5178,7 @@ void nd_det(int mod,MAT f,P *rp)
 	pointer **m;
 	Q mone;
 	P **w;
-	P mp;
+	P mp,r;
 	NDV **dm;
 	NDV *t,*mi,*mj;
 	NDV d,s,mij,mjj;
@@ -5107,6 +5187,8 @@ void nd_det(int mod,MAT f,P *rp)
 	UINT *bound;
 	PGeoBucket bucket;
 	struct order_spec *ord;
+	Q dq,dt,ds;
+	N gn,qn,dn0,nm,dn;
 
 	create_order_spec(0,0,&ord);
 	nd_init_ord(ord);
@@ -5130,6 +5212,28 @@ void nd_det(int mod,MAT f,P *rp)
 		}
 		return;
 	}
+	
+	if ( !mod ) {
+		w = (P **)almat_pointer(n,n);
+		dq = ONE;
+		for ( i = 0; i < n; i++ ) {
+			dn0 = ONEN;
+			for ( j = 0; j < n; j++ ) {
+				if ( !m[i][j] ) continue;
+				lgp(m[i][j],&nm,&dn);
+				gcdn(dn0,dn,&gn); divsn(dn0,gn,&qn); muln(qn,dn,&dn0);
+			}
+			if ( !UNIN(dn0) ) {
+				NTOQ(dn0,1,ds);
+				for ( j = 0; j < n; j++ )
+					mulp(CO,(P)m[i][j],(P)ds,&w[i][j]);
+				mulq(dq,ds,&dt); dq = dt;
+			} else
+				for ( j = 0; j < n; j++ )
+					w[i][j] = (P)m[i][j];
+		}
+		m = (pointer **)w;
+	}
 
 	for ( i = 0, max = 0; i < n; i++ )
 		for ( j = 0; j < n; j++ )
@@ -5212,7 +5316,11 @@ void nd_det(int mod,MAT f,P *rp)
 			ndv_mul_c(mod,d,mod-1);
 		else
 			ndv_mul_c_q(d,mone);
-	*rp = ndvtop(mod,CO,fv,d);
+	r = ndvtop(mod,CO,fv,d);
+	if ( !mod && !UNIQ(dq) )
+		divsp(CO,r,(P)dq,rp);
+	else
+		*rp = r;
 }
 
 ND ndv_mul_nmv_trunc(int mod,NMV m0,NDV p,UINT *d)