void estiva_std_R5(void *x, void *y)
{
int i;
if ( y == NULL ) {
i = where(x);
set(i,NULL,NULL);
if ( i == top ) top--;
}
else{
R5(x,NULL);
i = where(NULL);
set(i,x,y);
if ( i == top ) {
top++;
if ( top >= limit ) {
static void **tx, **ty;
ary1(tx,limit); ary1(ty,limit);
forall(0,i,top) tx[i] = x_array[i];
forall(0,i,top) ty[i] = y_array[i];
limit++;
ary1(x_array,limit); ary1(y_array,limit);
forall(0,i,top) x_array[i] = tx[i];
forall(0,i,top) y_array[i] = ty[i];
}
}
}
}
main(){
static MX *A; static double *x, *b;
initmx(A,3,3); ary1(x, 3); ary1(b, 3);
mx(A,1,1) = 1.0; mx(A,1,2) = 0.0; b[1] = 3.0;
mx(A,2,1) = 0.0; mx(A,2,2) = 1.0; b[2] = 2.0;
solver(A,x,b);
printf("%f\n", x[1] );
printf("%f\n", x[2] );
}
/* function subs */
static void subs(Matrix L,Matrix U,Vector b,Vector x,double tol,int n)
{
static Vector y;
double s;
int i, j, k;
ary1(y,n+1);
y[1]=b[1]/L[1][1];
for (i=2; i<=n; i++){
if (fabs(L[i][i])<tol)
printf("The pivot is too small\n");
s=0.0;
for (j=1; j<=i-1; j++)
s+=L[i][j]*y[j];
y[i]=(b[i]-s)/L[i][i];
}
x[n]=y[n]/U[n][n];
for (k=n-1; k>=1; k--){
s=0.0;
for (j=k+1; j<=n; j++)
s+=U[k][j]*x[j];
x[k]=(y[k]-s)/U[k][k];
}
}
void estiva_precondjacobi(MX *A, double *x, double *D, double *b)
{
int i,j,J,k,n, step = 2;
static double *xo;
if ( defop("-jacobistep") ) step = atoi(getop("-jacobistep"));
n = dim1(D);
ary1(xo,n+1);
for (i=0; i<n; i++) xo[i] = 0.0;
for(k=0;k<step;k++) {
for(i=0;i<n;i++) {
x[i]=b[i];
for(j=0; j< A->w; j++) {
J = A->IA[i][j];
if (J != 0) if ( J-1 != i) if(A->A[i][j] !=0.0) {
x[i] -= A->A[i][j]*xo[J-1];
}
}
x[i]=x[i]*D[i];
}
for(i=0;i<n;i++) xo[i]=x[i];
}
}
main(int argc, char **argv){
int i, n = 512;
static MX *A; static double *x, *b;
initop(argc,argv);
initmx(A,n+1,8); ary1(x, n+1); ary1(b, n+1);
for ( i =1; i<=n; i++){
mx(A,i,i) = 2.0; b[i] = 1.0;
}
for (i=1;i<n;i++) mx(A,i,i+1) = -1.0;
for (i=1;i<n;i++) mx(A,i+1,i) = -1.0;
solver(A,x,b);
for (i=1;i<=n;i++) printf("%f\n", x[i] );
}
int estiva_gmressolver(void *A, double *x, double *b)
{
static double *work, *h;
long n, ldw, iter, info, i,ldh, restrt;
double resid = 1.0e-7;
setAmx(A);
restrt = 50;
ldw = iter = n = dim1(b);
ldh = restrt+1;
ary1(work,ldw*(restrt+4));
ary1(h, ldh*(restrt+2));
forall (0, i, n ) x[i] = b[i];
ILUdecomp(A);
gmres_(&n,b+1,x+1,&restrt, work,&ldw,h,&ldh,&iter,&resid,estiva_matvec,
estiva_psolve,&info);
printf("gmres iter = %ld\n",iter);
return 0;
}
/* function invert */
static double invert(Matrix A,Vector x,double tol,int n,int *itr)
{
static Matrix L;
static Matrix U;
static Vector y;
static Vector s;
double c, d, xmin,lambda;
int m, i;
ary2(L,n+1,n+1);
ary2(U,n+1,n+1);
ary1(y,n+1);
ary1(s,n+1);
lu(A,L,U,tol,n); // AをLU分解する。結果はLとUに入れる
for (m=1; m<=itr[0]; m++){
for (i=1; i<=n; i++)
s[i]=x[i];
subs(L,U,s,y,tol,n); // LUy = s の解yを求める処理。
c=0; d=0;
for (i=1; i<=n; i++){
c+=y[i]*x[i];
d+=y[i]*y[i];
}
lambda =c/d;
itr[1]=m;
if (fabs(xmin-lambda)<tol){
return lambda; /* 収束した */
}
xmin=lambda;
for (i=1; i<=n; i++)
x[i]=y[i]/sqrt(d); // xにyを正規化して代入
}
itr[1]=m;
return lambda; //Itr回では収束しなかった
}
void estiva_mulmx(double **tp, MX *A, double *x){
long i, j, J, m = A->n, n = A->w;
double *t;
ary1(*tp, m+1);
t = *tp;
for(i=0; i< m; i++) t[i] = 0.0;
mx(A,1,1) = mx(A,1,1);
for(i=0; i< m; i++) for(j=0; j< n; j++) {
J = A->IA[i][j];
if (0<J) t[i] += A->A[i][j]*x[J-1];
}
}
int
main(int argc, char **argv)
{
static xyc *Z; static nde *N;
static double **A, *u;
initop(argc, argv);
fp2mesh(stdfp(),Z,N);
ary2(A,dim1(Z)+1, dim1(Z)+1); ary1(u,dim1(Z)+1);
set_A(Z,N,A); set_u(Z,u);
esolver(A,u);
plt(NULL,NULL,Z,N,u); sleep(1000);
return 0;
}
int estiva_qmrsolver(void *A, double *x, double *b)
{
static MX *AT;
static double *work;
long n, ldw, iter, info, i;
double resid = 1.0e-7;
transmx(AT,A);
setAmx(A);
setATmx(AT);
ldw = iter =n = dim1(b);
ary1(work,n*11);
setveclength(n);
forall (0, i, n ) x[i] = b[i];
ILUdecomp(A);
qmr_(&n,b+1,x+1,work,&ldw,&iter,&resid,estiva_matvec,
estiva_matvectrans, estiva_psolveq, estiva_psolvetransq,&info);
if (defop("-v")) fprintf(stderr, "qmr iter = %ld\n",iter);
return 0;
}
int estiva_cgsolver(void *A, double *x, double *b)
{
static double *work;
long n, ldw, iter, info, i;
double resid = 1.0e-7;
if ( !symcheckmx(A) ) {
fprintf(stderr,"matrix is not symmetric\n");
return 1;
}
setAmx(A);
ldw = iter = n = dim1(b);
ary1(work,n*4+1);
setveclength(n);
forall (0, i, n ) x[i] = b[i];
ILUdecomp(A);
distributemx(A);
cg_(&n,b+1,x+1,work,&ldw,&iter,&resid,estiva_matvecmpi2,estiva_psolve,&info);
if (defop("-v")) fprintf(stderr, "cg iter = %ld\n",iter);
return 0;
}
int estiva_pcgssolver(void* pA, double* x, double* b)
{
/* (i) 引数の型と種類 */
D_ D, B ;/* D 一次元配列 D(N), B(N) */
D__ A ;/* D 二次元配列 A(N1, 2 * NL) */
I__ IA ;/* I 二次元配列 IA(N1, 2 * NL) */
D_ R ;/* D 一次元配列 R(N) */
long NL, N1, N, ITR, IER ;
double EPS, S ;
D_ X, DD, P, Q ;/* D 一次元配列で, 要素は 0〜N */
I_ M ;/* I 一次元配列 M(2 * N) 作業用 */
/*-- DからRまでと, EPSからSまでの引数は, サブルーチンPCGと同じ --*/
D_ R0, E, H ;/* D 一次元配列 要素数はN */
D_ W ;/* D 一次元配列 W(0:N) */
long i, j, k ;
N = dim1(b) ;
NL = count_NL(pA,N);
ary1( D, N ) ;
ary2( A, 2*NL, N+2*NL );
ary2( IA, 2*NL, N+2*NL );
ary1( R, N ) ;
ary1( X, N+1 ) ; ary1( DD, N+1 ); ary1( P, N+1 ); ary1( Q, N+1 );
ary1( M, 2*N ) ;
ary1( R0, N ) ; ary1( E, N ); ary1( H, N );
ary1( W, N+1 ) ;
/* (ii) 主プログラム → サブルーチン */
/* サブルーチンをCALLするときには, つぎの値を与える. */
/* D : 配列Dの第1〜第n位置に行列Aの対角要素を入れておく */
/* N : 行列Aの行数を入れておく. */
/* N1 : 配列Aの行数を入れておく. N1≧N+2*NL でないといけない. */
/* NL : 行列Aの各行における非ゼロ要素数の最大値を入れておく. */
/* B : 連立一次方程式の右辺を入れておく. */
/* EPS : 収束判定置を入れておく. ふつうは 1.×10^(-7) */
/* ITR : 打切りまでの最大繰返し回数を入れておく. */
/*-- D, N, N1, NL, B, EPS, ITR については, サブルーチンPCGと同じ --*/
/* A : 配列Aの各行1〜NL要素は, 行列Aの下三角部分の各行の非ゼロ */
/* 要素を入れる. また, 各行のNL+1〜2*NL要素は, 上三角部分 */
/* の各行の非ゼロ要素を入れる. ただし, 各行の対角要素は配列Dに */
/* 入れる. */
/* IA : 配列Aに入れた要素の列番号を, 対応する位置に入れておく. */
/* S : LUCGS法のとき 0., MLUCG法のときσ(>0)を入れておく. */
for(i=1; i<=N; i++) D[i-1] = mx(pA,i,i);
for(i=1; i<=N; i++)for(k=0, j=1; j<i; j++)if(mx(pA,i,j) != 0.0){
A[k][i-1] = mx(pA,i,j) ;
IA[k][i-1] = j ;
k++ ;
}
for(i=1; i<=N; i++)for(k=NL, j=i+1; j<=N; j++)if(mx(pA,i,j) != 0.0){
A[k][i-1] = mx(pA,i,j) ;
IA[k][i-1] = j ;
k++ ;
}
N1 = N+2*NL;
B = &b[1] ;
EPS = 1.0e-7 ;
ITR = N ;
S = 0. ;
/* (a) リンクの方法 */
/* CALL PCGS(D,A,IA,N,N1,NL,B,EPS,ITR,S,X,DD,P,Q,R,R0,E,H,W,M,IER) */
pcgs(D,A[0],IA[0],&N,&N1,&NL,B,&EPS,&ITR,
&S,X,DD,P,Q,R,R0,E,H,W,M,&IER);
B = &x[1] ;
for(i=0; i<N; i++) B[i] = X[i+1];
return IER;
}
int estiva_cgssolver(void *Apointer, double *x, double *b)
{
static double *dd, *p, *phat, *q, *qhat, *r, *rtld, *tmp, *u, *uhat, *vhat;
MX *A;
double alpha, beta, bnrm2, rho, rho1=1.0;
long itr, n;
A = Apointer;
n = A->n;
ILUdecomp(A);
setveclength(n+1);
if ( defop("-adjust") ) {
setveclength(n);
b=&b[1];
x=&x[1];
}
ary1(r ,n+1);
ary1(rtld ,n+1);
ary1(p ,n+1);
ary1(phat ,n+1);
ary1(q ,n+1);
ary1(qhat ,n+1);
ary1(u ,n+1);
ary1(uhat ,n+1);
ary1(vhat ,n+1);
ary1(tmp ,n+1);
ary1(dd, n+1);
cpvec(b,x);
cpvec(b, r);
if ( L2(x) != 0.0 ) {
matvecvec(A,-1.0, x, 1.0, r);
if (L2(r) <= 1.0e-7) return 0;
}
bnrm2 = L2(b);
if (bnrm2 == 0.0) bnrm2 = 1.0;
cpvec(r, rtld);
for (itr = 1; itr < n; itr++) {
rho = dotvec(rtld,r);
if (fabs(rho) < 1.2e-31) break;
if ( itr == 1 ) {
cpvec(r,u);
cpvec(u,p);
} else {
beta = rho / rho1;
addformula( u, '=', r, '+', beta, q);
addformula( p, '=', u, '+', beta, addformula( tmp, '=',q,'+',beta,p));
}
cpvec(p,phat);
psolvevec(A,phat);
matvecvec(A,1.0, phat, 0.0, vhat );
alpha = rho / dotvec(rtld, vhat);
addformula( q, '=', u, '-', alpha, vhat);
cpvec(addformula(phat, '=', u, '+', 1.0, q),uhat);
psolvevec(A,uhat);
addformula(x, '=', x, '+', alpha, uhat);
matvecvec(A,1.0, uhat, 0.0, qhat );
addformula(r, '=', r, '-',alpha,qhat);
if ( L2(r) / bnrm2 <= epsilon() && stopcondition(A,x,b) )
return success(itr);
rho1 = rho;
}
return 1;
}
void estiva_fp2mesh(void* vfp, xyc** Zp, nde** Np)
{
FILE *fp;
static xyc* Z; static nde* N;
char buf1000[1000], buf200[200];
int i, j, m=0, n=0, state = 1;
fp = vfp;
while(fgets(buf1000,999,fp)) switch(state){
case 1:
sscanf(buf1000,"%s",buf200);
if(!strcmp(buf200,"<nde>")) state = 2;
else m = atoi(buf200);
break;
case 2:
sscanf(buf1000,"%s",buf200);
n = atoi(buf200);
break;
}
ary1(Z,m+1); ary1(N,n+1);
if(Z == NULL || N == NULL){
fprintf(stderr,"poisson: Can't alloc memory!\n");
abort();
}
rewind(fp);
state = 1;
while(fgets(buf1000,999,fp)) switch(state){
case 1:
sscanf(buf1000,"%s",buf200);
if(!strcmp(buf200,"<xyc>")) state = 1;
else if(!strcmp(buf200,"<nde>")) state = 2;
else{
sscanf(buf200,"%d",&i);
Z[i].label = (char*)malloc(16);
if(Z[i].label == NULL){
fprintf(stderr,"poisson: Can't alloc memory\n");
abort();
}
sscanf(buf1000,"%d %lf %lf %s",&m, &Z[i].x, &Z[i].y,Z[i].label);
}
break;
case 2:
sscanf(buf1000,"%s",buf200);
sscanf(buf200,"%d",&j);
sscanf(buf1000,"%d %d %d %d %d %d %d",&n, &N[j].a, &N[j].b, &N[j].c,
&N[j].A,&N[j].B,&N[j].C);
break;
}
*Zp = Z;
*Np = N;
}
void estiva_initq(que **q)
{
if ( *q == NULL ) ary1(*q,1); //*q = calloc(1,sizeof(que));
}