version 1.4, 2000/08/22 05:04:04 |
version 1.7, 2001/10/01 01:58:03 |
|
|
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* |
* |
* $OpenXM: OpenXM_contrib2/asir2000/engine/PU.c,v 1.3 2000/08/21 08:31:26 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/engine/PU.c,v 1.6 2001/06/07 04:54:40 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
|
|
|
|
*dp = d; |
*dp = d; |
} |
} |
|
|
|
void invmatp(vl,rmat,n,imatp,dnp) |
|
VL vl; |
|
P **rmat; |
|
int n; |
|
P ***imatp; |
|
P *dnp; |
|
{ |
|
int i,j,k,l,n2; |
|
P mjj,mij,t,s,u,d; |
|
P **mat,**imat; |
|
P *mi,*mj,*w; |
|
|
|
n2 = n<<1; |
|
mat = (P **)almat_pointer(n,n2); |
|
for ( i = 0; i < n; i++ ) { |
|
for ( j = 0; j < n; j++ ) |
|
mat[i][j] = rmat[i][j]; |
|
mat[i][i+n] = (P)ONE; |
|
} |
|
for ( j = 0, d = (P)ONE; j < n; j++ ) { |
|
for ( i = j; (i < n) && !mat[i][j]; i++ ); |
|
if ( i == n ) { |
|
error("invmatp : input is singular"); |
|
} |
|
for ( k = i; k < n; k++ ) |
|
if ( mat[k][j] && (nmonop(mat[k][j]) < nmonop(mat[i][j]) ) ) |
|
i = k; |
|
if ( j != i ) { |
|
mj = mat[j]; mat[j] = mat[i]; mat[i] = mj; |
|
} |
|
for ( i = j + 1, mj = mat[j], mjj = mj[j]; i < n; i++ ) |
|
for ( k = j + 1, mi = mat[i], mij = mi[j]; k < n2; k++ ) { |
|
mulp(vl,mi[k],mjj,&t); mulp(vl,mj[k],mij,&s); |
|
subp(vl,t,s,&u); divsp(vl,u,d,&mi[k]); |
|
} |
|
d = mjj; |
|
} |
|
/* backward substitution */ |
|
w = (P *)ALLOCA(n2*sizeof(P)); |
|
for ( i = n-2; i >= 0; i-- ) { |
|
bzero(w,n2*sizeof(P)); |
|
for ( k = i+1; k < n; k++ ) |
|
for ( l = k, u = mat[i][l]; l < n2; l++ ) { |
|
mulp(vl,mat[k][l],u,&t); addp(vl,w[l],t,&s); w[l] = s; |
|
} |
|
for ( j = i, u = mat[i][j]; j < n2; j++ ) { |
|
mulp(vl,mat[i][j],d,&t); subp(vl,t,w[j],&s); |
|
divsp(vl,s,u,&mat[i][j]); |
|
} |
|
} |
|
imat = (P **)almat_pointer(n,n); |
|
for ( i = 0; i < n; i++ ) |
|
for ( j = 0; j < n; j++ ) |
|
imat[i][j] = mat[i][j+n]; |
|
*imatp = imat; |
|
*dnp = d; |
|
} |
|
|
void reordvar(vl,v,nvlp) |
void reordvar(vl,v,nvlp) |
VL vl; |
VL vl; |
V v; |
V v; |
|
|
factorial(QTOS(n)+QTOS(m),&t); |
factorial(QTOS(n)+QTOS(m),&t); |
mulq(u,t,&s); addq(s,s,&f); |
mulq(u,t,&s); addq(s,s,&f); |
for ( index = 0, q = ONE, c = 0; cmpq(f,q) >= 0; ) { |
for ( index = 0, q = ONE, c = 0; cmpq(f,q) >= 0; ) { |
mod = lprime[index++]; |
mod = get_lprime(index++); |
if ( !mod ) |
|
error("sqfrum : lprime[] exhausted."); |
|
ptomp(mod,LC(q1),&tg); |
ptomp(mod,LC(q1),&tg); |
if ( !tg ) |
if ( !tg ) |
continue; |
continue; |
|
|
factorial(QTOS(n)+QTOS(m),&t); |
factorial(QTOS(n)+QTOS(m),&t); |
mulq(u,t,&s); addq(s,s,&f); |
mulq(u,t,&s); addq(s,s,&f); |
for ( index = 0, q = ONE, c = 0; cmpq(f,q) >= 0; ) { |
for ( index = 0, q = ONE, c = 0; cmpq(f,q) >= 0; ) { |
mod = lprime[index++]; |
mod = get_lprime(index++); |
if ( !mod ) |
|
error("sqfrum : lprime[] exhausted."); |
|
ptomp(mod,LC(q1),&tg); |
ptomp(mod,LC(q1),&tg); |
if ( !tg ) |
if ( !tg ) |
continue; |
continue; |
|
|
{ |
{ |
Q c; |
Q c; |
|
|
ptozp(p,1,&c,pr); |
if ( qpcheck((Obj)p) ) |
|
ptozp(p,1,&c,pr); |
|
else |
|
*pr = p; |
} |
} |
|
|
void mindegp(vl,p,mvlp,pr) |
void mindegp(vl,p,mvlp,pr) |