static void
set_A(xyc *Z, nde *N, double **A)
{
int n, i, j, k;
double S, D, xi, yi, xj, yj, xk, yk, b1, b2, b3, c1, c2, c3;
for(n=1;n<=dim1(N);n++){
i=N[n].a; j=N[n].b; k=N[n].c;
xi = Z[i].x; yi = Z[i].y;
xj = Z[j].x; yj = Z[j].y;
xk = Z[k].x; yk = Z[k].y;
D = xi*(yj-yk)+xj*(yk-yi)+xk*(yi-yj);
S = fabs(D)/2.0;
b1=(yj-yk)/D; b2=(yk-yi)/D; b3=(yi-yj)/D;
c1=(xk-xj)/D; c2=(xi-xk)/D; c3=(xj-xi)/D;
A[i][i]+=S*(b1*b1+c1*c1);A[i][j]+=S*(b2*b1+c2*c1);A[i][k]+=S*(b3*b1+c3*c1);
A[j][i]+=S*(b1*b2+c1*c2);A[j][j]+=S*(b2*b2+c2*c2);A[j][k]+=S*(b3*b2+c3*c2);
A[k][i]+=S*(b1*b3+c1*c3);A[k][j]+=S*(b2*b3+c2*c3);A[k][k]+=S*(b3*b3+c3*c3);
}
for(n=1;n<=dim1(Z);n++) if(!strcmp("boundary",Z[n].label))
A[n][n]= 1000000000000000000000000000.0;
}
int solver_gauss(void *A, void *B)
{ void *X;
if(dim1(A) != dim1(B)) return 0;
{ static int **Y;
if(-1 == dim2(B)){
ary2(Y,2,1);
if(NULL == Y) return 0;
cp(B,Y[1]); cp(Y,X);
}else cp(B,X);
}
if(siz(A) == sizeof(float) && siz(B) == sizeof(float)){
float **a,*api,s,**x,*b,bpi;
#include "solver/fb.c"
}else if(siz(A) == sizeof(float) && siz(B) == sizeof(double)){
float **a,*api;double s,**x,*b,bpi;
#include "solver/fb.c"
}else if(siz(A) == sizeof(double) && siz(B) == sizeof(float)){
double **a,*api,s;float **x,*b,bpi;
#include "solver/fb.c"
}else if(siz(A) == sizeof(double) && siz(B) == sizeof(double)){
double **a,*api,s,**x,*b,bpi;
#include "solver/fb.c"
}else{ fprintf(stderr,"solver_gauss: not supported\n"); exit(1);}
return 0;
}
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];
}
}
int matprop_halfbw(void *A)
{
if(dim2(A) != dim1(A)||dim2(A) < 1||dim1(A) < 1||siz(A) < 1) return 0;
if(siz(A) == sizeof(float)){
static float **a;
a = (float **)A;
#include "matprop/halfbw.c"
}
if(siz(A) == sizeof(double)){
static double **a;
a = (double **)A;
#include "matprop/halfbw.c"
}
return 0;
}
template<class T> std::string Data::Matrix<T>::print( const std::string & label , const int nrow , const int ncol) const
{
int arow = nrow == 0 || nrow > dim1() ? dim1() : nrow ;
int acol = ncol == 0 || ncol > dim2() ? dim2() : ncol ;
std::stringstream ss;
if ( label != "" ) ss << label << "\n";
for (int r=0;r<arow;r++)
{
ss << " [" ;
for (int c=0;c<acol;c++)
ss << " " << (*this)(r,c) ;
ss << " ]\n";
}
return ss.str();
}
int solver_inv(void *A)
{ if(dim2(A) == dim1(A))
if(siz(A) == sizeof(float)){ static float **a,**e;
#include "solver/inv.c"
}else if(siz(A) == sizeof(double)){ static double **a,**e;
#include "solver/inv.c"
}else{ fprintf(stderr,"solver_inv: not supported\n"); exit(1);}
return 0;
}
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;
}
static int *LU(void *A)
{ if(dim2(A) == dim1(A))
if(siz(A) == sizeof(float)){ float nrm,**a,aik,*apk,*ai,apkk;
#include "solver/LU.c"
}else if(siz(A) == sizeof(double)){ double nrm,**a,aik,*apk,*ai,apkk;
#include "solver/LU.c"
}
return NULL;
}
void femlib_ary1(void** v, long n_1, size_t o)
{
if(*v == NULL){ new_ary1(v,n_1,o); return;}
if(n_1 == dim1(*v)+1) return;
del_ary1(v);
if(n_1 != 0) new_ary1(v,n_1,o);
}
void femlib_ary2(void** v, long m_1, long n_1, size_t o)
{
if(*v == NULL){ new_ary2(v,m_1,n_1,o); return;}
if(m_1==dim2(*v)+1 && n_1==dim1(*v)+1) return;
del_ary2(v);
if(m_1!=0 && n_1!=0) new_ary2(v,m_1,n_1,o);
}
static void pltmsh(FILE *fp, xyc *Z, nde *N)
{
long e, a, b, c;
for(e=1;e<=dim1(N);e++){
a = N[e].a, b = N[e].b, c = N[e].c;
fprintf(fp,"%f %f %f\n",Z[a].x,Z[a].y);
fprintf(fp,"%f %f %f\n",Z[b].x,Z[b].y);
fprintf(fp,"%f %f %f\n",Z[c].x,Z[c].y);
fprintf(fp,"%f %f %f\n",Z[a].x,Z[a].y);
fprintf(fp,"\n\n");
}
}
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;
}
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;
}
static void
set_u(xyc *Z, double *u)
{
int n;
for(n=1; n<=dim1(Z); n++) u[n] = 1.0;
}
double estiva_minesolver(double **A, double *x)
{
int i, n=dim1(x), itr[2]={Itr, 0};
return invert(A,x,tol,n,itr);
}
// return major dimension
size_type dim1() const
{
return dim1(orientation());
}
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;
}