Ejemplo n.º 1
0
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];
      }
    }
  }
}
Ejemplo n.º 2
0
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] );
}
Ejemplo n.º 3
0
/* 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];
  }
}
Ejemplo n.º 4
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];
  }
}
Ejemplo n.º 5
0
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] );
}
Ejemplo n.º 6
0
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;
}
Ejemplo n.º 7
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回では収束しなかった
		      }
Ejemplo n.º 8
0
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];
  }
}
Ejemplo n.º 9
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;
}
Ejemplo n.º 10
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;
}
Ejemplo n.º 11
0
Archivo: cg.c Proyecto: tsukud-y/estiva
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;
}
Ejemplo n.º 12
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;
}
Ejemplo n.º 13
0
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;
}
Ejemplo n.º 14
0
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;
}
Ejemplo n.º 15
0
void estiva_initq(que **q)
{
  if ( *q == NULL ) ary1(*q,1); //*q = calloc(1,sizeof(que));
}