=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/engine/nd.c,v retrieving revision 1.217 retrieving revision 1.219 diff -u -p -r1.217 -r1.219 --- OpenXM_contrib2/asir2000/engine/nd.c 2014/02/03 02:43:05 1.217 +++ OpenXM_contrib2/asir2000/engine/nd.c 2014/08/19 06:35:01 1.219 @@ -1,4 +1,4 @@ -/* $OpenXM: OpenXM_contrib2/asir2000/engine/nd.c,v 1.216 2013/12/20 04:35:34 noro Exp $ */ +/* $OpenXM: OpenXM_contrib2/asir2000/engine/nd.c,v 1.218 2014/02/24 01:45:28 noro Exp $ */ #include "nd.h" @@ -13,6 +13,8 @@ ND _nd_free_list; ND_pairs _ndp_free_list; NODE nd_hcf; +Obj nd_top_weight; + static NODE nd_subst; static VL nd_vc; static int nd_ntrans; @@ -497,11 +499,37 @@ int ndl_block_compare(UINT *d1,UINT *d2) int ndl_matrix_compare(UINT *d1,UINT *d2) { - int i,j,s; + int i,j,s,row; int *v; + Q **mat; + Q *w; + Q t,t1,t2; for ( j = 0; j < nd_nvar; j++ ) nd_work_vector[j] = GET_EXP(d1,j)-GET_EXP(d2,j); + if ( nd_top_weight ) { + if ( OID(nd_top_weight) == O_VECT ) { + mat = (Q **)&BDY((VECT)nd_top_weight); + row = 1; + } else { + mat = (Q **)BDY((MAT)nd_top_weight); + row = ((MAT)nd_top_weight)->row; + } + for ( i = 0; i < row; i++ ) { + w = (Q *)mat[i]; + for ( j = 0, t = 0; j < nd_nvar; j++ ) { + STOQ(nd_work_vector[j],t1); + mulq(w[j],t1,&t2); + addq(t,t2,&t1); + t = t1; + } + if ( t ) { + s = SGN(t); + if ( s > 0 ) return 1; + else if ( s < 0 ) return -1; + } + } + } for ( i = 0; i < nd_matrix_len; i++ ) { v = nd_matrix[i]; for ( j = 0, s = 0; j < nd_nvar; j++ ) @@ -509,6 +537,8 @@ int ndl_matrix_compare(UINT *d1,UINT *d2) if ( s > 0 ) return 1; else if ( s < 0 ) return -1; } + if ( !ndl_equal(d1,d2) ) + error("afo"); return 0; } @@ -6068,21 +6098,22 @@ NODE nd_f4(int m,int **indp) node = BDY((LIST)BDY(tn)); if ( QTOS((Q)ARG0(node)) == sugar ) break; } - if ( !tn ) error("nd_f4 : inconsistent non-zero list"); - for ( t = l, ll0 = 0; t; t = NEXT(t) ) { - for ( tn = BDY((LIST)ARG1(node)); tn; tn = NEXT(tn) ) { - i1s = QTOS((Q)ARG0(BDY((LIST)BDY(tn)))); - i2s = QTOS((Q)ARG1(BDY((LIST)BDY(tn)))); - if ( t->i1 == i1s && t->i2 == i2s ) break; - } - if ( tn ) { - if ( !ll0 ) ll0 = t; - else NEXT(ll) = t; - ll = t; - } - } - if ( ll0 ) NEXT(ll) = 0; - l = ll0; + if ( tn ) { + for ( t = l, ll0 = 0; t; t = NEXT(t) ) { + for ( tn = BDY((LIST)ARG1(node)); tn; tn = NEXT(tn) ) { + i1s = QTOS((Q)ARG0(BDY((LIST)BDY(tn)))); + i2s = QTOS((Q)ARG1(BDY((LIST)BDY(tn)))); + if ( t->i1 == i1s && t->i2 == i2s ) break; + } + if ( tn ) { + if ( !ll0 ) ll0 = t; + else NEXT(ll) = t; + ll = t; + } + } + if ( ll0 ) NEXT(ll) = 0; + l = ll0; + } else l = 0; } bucket = create_pbucket(); stat = nd_sp_f4(m,0,l,bucket); @@ -7947,6 +7978,7 @@ MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *o pi0 = QTOS((Q)ARG0(pi)); pi1 = QTOS((Q)ARG1(pi)); p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND)); ptomp(mod,(P)ARG2(pi),&inv); + ((MQ)inv)->cont = invm(((MQ)inv)->cont,mod); u = ptond(CO,vv,(P)ONE); HCM(u) = ((MQ)inv)->cont; c[pi1] = u; @@ -8018,7 +8050,8 @@ VECT nd_btog_one(LIST f,LIST v,int mod,struct order_sp pi = BDY((LIST)BDY(t)); pi0 = QTOS((Q)ARG0(pi)); pi1 = QTOS((Q)ARG1(pi)); if ( pi1 == pos ) { - ptomp(mod,(P)ARG2(pi),&inv); + ptomp(mod,(P)ARG2(pi),&inv); + ((MQ)inv)->cont = invm(((MQ)inv)->cont,mod); u = ptond(CO,vv,(P)ONE); HCM(u) = ((MQ)inv)->cont; p[pi0] = u;