Esempio n. 1
0
void Hex::fill_column(double **Mat, int loc, Bsystem *B, int nm, int offset){
  int       N,ll,tid,gid;
  const int nvs = B->nv_solve, nes = B->ne_solve;
  int      *e = B->edge;
  register int j;

  N = Nmodes-Nbmodes;

  for(j = 0; j < NHex_verts; ++j)
    if(vert[j].gid < nvs)
      Mat[vert[j].gid][loc] += vert[j].hj[0];

  for(j = 0; j < NHex_edges; ++j)
    if((gid = edge[j].gid) < nes){
      ll = edge[j].l;
      dvadd(ll,edge[j].hj,1,Mat[e[gid]]+loc,nm,Mat[e[gid]]+loc,nm);
    }

  tid = B->nsolve + offset;
  if(N) dvadd(N,*face->hj,1,Mat[tid]+loc,nm,Mat[tid]+loc,nm);
}
Esempio n. 2
0
main()
{
   /* test program for above utility routines */

   double **a, **b, **c, **bT;
   double *x, *y, *z;
   FILE *infile, *outfile;
   int a_rows, a_cols, b_rows, b_cols, errors, xn, yn;

   infile = fopen("mat.in", "r");
   outfile = fopen("mat.dat", "w");

   a = dReadMatrix( infile, &a_rows, &a_cols, &errors);
   b = dReadMatrix( infile, &b_rows, &b_cols, &errors);
   x = dReadVector( infile, &xn, &errors);
   y = dReadVector( infile, &yn, &errors);
   getchar();

   dmdump( stdout, "Matrix A", a, a_rows, a_cols, "%8.2lf");
   dmdump( stdout, "Matrix B", b, b_rows, b_cols, "%8.2lf");
   dvdump( stdout, "Vector x", x, xn, "%8.2lf");
   dvdump( stdout, "Vector y", y, yn, "%8.2lf");
   z = dvector( 1, xn );
   dvadd( x, xn, y, z );
   dvdump( stdout, "x + y", z, xn, "%8.2lf");
   dvsub( x, xn, y, z );
   dvdump( stdout, "x - y", z, xn, "%8.2lf");
   dvsmy( x, xn, 2.0, z );
   dvdump( stdout, "2x", z, xn, "%8.2lf");
   printf("Magnitude of 2x: %7.2lf\n", dvmag( z, xn ));
   printf("dot product x.y: %7.2lf\n", dvdot( x, xn, y));

   dmvmult( a, a_rows, a_cols, x, xn, z );
   dvdump( stdout, "Ax", z, xn, "%8.2lf");

   c = dmatrix( 1, a_rows, 1, b_cols );    
   bT = dmatrix( 1, b_cols, 1, b_rows );
   dmtranspose( b, b_rows, b_cols, bT);
   dmdump( stdout, "Matrix B (transposed)", bT, b_cols, b_rows, "%8.2lf");
   dmmult( a, a_rows, a_cols, bT, b_cols, b_rows, c);
   dmdump( stdout, "Matrix AB", c, a_rows, b_rows, "%8.2lf");

   /*  dmfillUT( a, a_rows, a_cols );
       dmdump( stdout, "Symmetrified matrix A", a, a_rows, a_cols, "%8.2lf"); */

   free_dmatrix( a, 1, a_rows, 1, a_cols);
   free_dmatrix( b, 1, b_rows, 1, b_cols);
   free_dmatrix( c, 1, a_rows, 1, b_cols);
   free_dvector( x, 1, xn );
   free_dvector( y, 1, yn );
}
Esempio n. 3
0
/* This routine integrates the transformed values */
void integrate_CNAB(int Je, double dt, Element_List *U, Element_List *Uf[])
{
	register  int i;
	int       nq = U->hjtot*U->nz;

	dsmul(nq, Beta_Int[Je-1]*dt, Uf[Je-1]->base_hj, 1, Uf[Je-1]->base_hj, 1);

	for(i = 0; i < Je-1; ++i)
		daxpy(nq, Beta_Int[i]*dt, Uf[i]->base_hj,1, Uf[Je-1]->base_hj, 1);

	dvadd(nq, Uf[Je-1]->base_hj,1, U->base_hj, 1, U->base_hj, 1);

	reshuffle(Uf,Je);
}
Esempio n. 4
0
static void SetupRecur_Precon(Bsystem *B){
  MatPre   *M     = B->Pmat = (MatPre *)malloc(sizeof(MatPre));

  /* at present just store diagonal of whole matrix in M->ivert */
  switch(B->Precon){
  case Pre_Diag: /* diagonal preconditioner */
    {
      Rsolver    *R = B->rslv;
      int      nsolve = R->rdata[R->nrecur-1].cstart;
      double   **a    = R->A.a;
      Recur    *rdata = R->rdata + R->nrecur-1;
      int      npatch = rdata->npatch;
      int      *alen  = rdata->patchlen_a;
      int      **map  = rdata->map;
      int       i,n,pos;

      M->info.diag.ndiag = nsolve;
      M->info.diag.idiag = dvector(0,nsolve-1);
      dzero(nsolve,M->info.diag.idiag,1);

      for(n = 0; n < npatch; ++n)
  for(i = 0,pos = 0; i < alen[n]; pos +=alen[n]-i,++i)
    M->info.diag.idiag[map[n][i]] += a[n][pos];
      InvtPrecon(B);
    }
    break;
  case Pre_Block: /* block diagonal preconditioner */
    {
#if 0
      register int j,k;
      int      al, gid, gid1, pos, nvs = B->rslv->Ainfo.nv_solve;
      Blockp   Blk = B->rslv->precon->blk;

      M->nvert = nvs;
      if(nvs) {
  M->ivert = dvector(0, nvs*(nvs+1)/2-1);
  dzero(nvs*(nvs+1)/2,M->ivert,1);
      }

      M->nedge = Blk.nlgid;
      M->Ledge = ivector(0,M->nedge-1);
      M->iedge = (double **)malloc(M->nedge*sizeof(double *));

      for(i = 0; i < npatch; ++i)
  for(j = 0; j < Blk.nle[i]; ++j)
    M->Ledge[Blk.lgid[i][j]] = Blk.edglen[i][j];


      for(i = 0; i < M->nedge; ++i){
  M->iedge[i] = dvector(0,M->Ledge[i]*(M->Ledge[i]+1)/2-1);
  dzero(M->Ledge[i]*(M->Ledge[i]+1)/2,M->iedge[i],1);
      }

      /* For the iterative solver all the global vertex dof are
   listed first then the local dof and finally the local edges */
      for(i = 0; i < npatch; ++i){
  al = alen[i];

  for(j =0,pos = 0; j < Blk.ngv[i]; ++j, pos += al--){
    gid = map[i][j];
    M->ivert[(gid*(gid+1))/2 + gid*(nvs-gid)] += a[i][pos];
    for(k = j+1; k < Blk.ngv[i]; ++k){
      gid1 = map[i][k];
      if(gid < gid1)
        M->ivert[(gid*(gid+1))/2 + gid*(nvs-gid) + gid1-gid]
    += a[i][pos+k-j];
      else if(gid == gid1) /* special case of periodic element */
        M->ivert[(gid*(gid+1))/2 + gid*(nvs-gid1)]
    += 2*a[i][pos+k-j];
      else
        M->ivert[(gid1*(gid1+1))/2 + gid1*(nvs-gid1) + gid-gid1]
    += a[i][pos+k-j];
    }
  }

  /* set up local blocks - note: it is assumed that the local
     vertices are ordered in a similar fashion either side of
     the patch */
  for(j = 0; j < Blk.nle[i]; ++j){
    for(k = 0,n=0; k < Blk.edglen[i][j];pos += al--,
        n += Blk.edglen[i][j]-k, ++k)
      dvadd(Blk.edglen[i][j]-k,a[i]+pos,1,M->iedge[Blk.lgid[i][j]]+n,1,
      M->iedge[Blk.lgid[i][j]]+n,1);
  }
      }
      InvtPrecon(B, nsolve);
#endif
    fprintf(stderr,"H_MatrixR.C: iterative -r not implemented\n");
    }
    break;
  case Pre_None: /* no preconditioner */
    break;
  default:
    error_msg(Unknown value of PRECON);
    break;
  }
}
Esempio n. 5
0
static void  Bsolve_Stokes_PCG(Element_List **V, Bsystem **B, double *p){
  int    eDIM = V[0]->flist[0]->dim();
  const  int nsolve = B[eDIM]->nsolve;
  int    iter = 0;
  double tolcg, alpha, beta, eps, rtz, rtz_old, epsfac;
  static double *u0 = (double*)0;
  static double *u  = (double*)0;
  static double *r  = (double*)0;
  static double *w  = (double*)0;
  static double *z  = (double*)0, **wk;
  static int nsol = 0, nglob = 0;

  if(nsolve > nsol){
    if(nsol){
      free(u0); free(u); free(r); free(z); free_dmatrix(wk,0,0);
    }

    /* Temporary arrays */
    u0 = dvector(0,B[eDIM]->nglobal-1);/* intial divergence-free solution */
    u  = dvector(0,nsolve-1);          /* Solution                        */
    r  = dvector(0,nsolve-1);          /* residual                        */
    z  = dvector(0,nsolve-1);          /* precondition solution           */

    if(eDIM == 2)
      wk = dmatrix(0,1,0,eDIM*4*LGmax);
    else
      wk = dmatrix(0,1,0,eDIM*6*LGmax*LGmax);

    nsol = nsolve;
  }
  if(B[eDIM]->nglobal > nglob){
    if(nglob)
      free(w);
    w  = dvector(0,B[eDIM]->nglobal-1);      /* A*Search direction    */
    nglob = B[eDIM]->nglobal;
  }

  divergence_free_init(V,u0,p,B,wk);

  dzero (B[eDIM]->nglobal, w, 1);
  dzero (nsolve, u, 1);
  dcopy (nsolve, p, 1, r, 1);

  tolcg  = dparam("TOLCG");
  epsfac = 1.0;
  eps    = sqrt(ddot(nsolve,r,1,r,1))*epsfac;

  if (option("verbose") > 1)
    printf("\t %3d iterations, error = %#14.6g %lg %lg\n",
     iter, eps/epsfac, epsfac, tolcg);

  rtz = eps;
  /* =========================================================== *
   *            ---- Conjugate Gradient Iteration ----           *
   * =========================================================== */

  while (eps > tolcg && iter++ < MAX_ITERATIONS ){
    /* while (sqrt(rtz) > tolcg && iter++ < MAX_ITERATIONS ){*/
    Precon_Stokes(V[0],B[eDIM],r,z);
    rtz  = ddot (nsolve, r, 1, z, 1);

    if (iter > 1) {                         /* Update search direction */
      beta = rtz / rtz_old;
      dsvtvp(nsolve, beta, p, 1, z, 1, p, 1);
    }
    else
      dcopy(nsolve, z, 1, p, 1);

    A_Stokes(V,B,p,w,wk);

    alpha = rtz/ddot(nsolve, p, 1, w, 1);

    daxpy(nsolve, alpha, p, 1, u, 1);            /* Update solution...   */
    daxpy(nsolve,-alpha, w, 1, r, 1);            /* ...and residual      */

    rtz_old = rtz;
    eps = sqrt(ddot(nsolve, r, 1, r, 1))*epsfac; /* Compute new L2-error */

    fprintf(stdout,"%d %lg %lg\n",iter,eps,sqrt(rtz));
  }

  /* =========================================================== *
   *                        End of Loop                          *
   * =========================================================== */

  /* Save solution and clean up */

  dcopy(nsolve,u,1,p,1);

  /* add back u0 */
  dvadd(nsolve,u0,1,p,1,p,1);

  if (iter > MAX_ITERATIONS){
    error_msg (Bsolve_Stokes_CG failed to converge);
  }
  else if (option("verbose") > 1)
    printf("\t %3d iterations, error = %#14.6g %lg %lg\n",
     iter, eps/epsfac, epsfac, tolcg);

  return;
}
Esempio n. 6
0
void solve_boundary(Element_List **V, Element_List **Vf,
        double *rhs, double *u0, Bsystem **Vbsys){
  int    eDIM = V[0]->flist[0]->dim();
  const  int nsolve = Vbsys[eDIM]->nsolve;
  int    info;
  Bsystem *B = Vbsys[0], *PB = Vbsys[eDIM];

  if(nsolve){
    const  int bwidth = PB->Gmat->bwidth_a;


    if(B->rslv){ /* recursive Static condensation solver */

      Rsolver *R    = PB->rslv;
      int    nrecur = R->nrecur;
      int    aslv   = R->rdata[nrecur-1].cstart, bw = R->Ainfo.bwidth_a;

      Recur_setrhs(R,rhs);

      if(PB->singular)
  rhs[PB->singular-1] = 0.0;

      if(B->smeth == direct){
  if(aslv)
    if(2*bw < aslv){       /* banded matrix */
      error_msg(error in solve_boundary_pressure);
    }
    else                /* symmetric matrix */
      dsptrs('L', aslv, 1, R->A.inva, R->A.pivota, rhs, aslv, info);
      }
      else{
  error_msg(Implement recursive iterative solver);
  /*Recur_Bsolve_CG(PB,rhs,U->flist[0]->type);*/
      }

      Recur_backslv(R,rhs,'n');
    }
    else{

      if(PB->singular)
  rhs[PB->singular-1] = 0.0;

      if(B->smeth == iterative){
  if(iparam("ITER_PCR")){
    Bsolve_Stokes_PCR(V, Vbsys, rhs);
  }
  else
    Bsolve_Stokes_PCG(V, Vbsys, rhs);
      }
      else{
  if(B->lambda->wave){
     if(3*bwidth < nsolve){ /* banded matrix */
      error_msg(pack non-symmetrix solver not completed);
    }
    else                  /* symmetric matrix */
      dgetrs('N', nsolve,1, *PB->Gmat->inva, nsolve,
       PB->Gmat->pivota, rhs, nsolve,info);
  }
  else{
     if(2*bwidth < nsolve) /* banded matrix */
      dpbtrs('L', nsolve, bwidth-1, 1, *PB->Gmat->inva, bwidth,
       rhs, nsolve, info);
    else                  /* symmetric matrix */
      dsptrs('L', nsolve,1, *PB->Gmat->inva, PB->Gmat->pivota, rhs,
       nsolve,info);
  }
      }
    }
  }

  /* add intial conditions for pressure and  internal velocity solve*/
  dvadd(PB->nglobal,u0,1,rhs,1,rhs,1);
  ScatrBndry_Stokes(rhs,V,Vbsys);
}
Esempio n. 7
0
static void setupRHS (Element_List **V, Element_List **Vf,double *rhs,
          double *u0, Bndry **Vbc, Bsystem **Vbsys){
  register int i,k;
  int      N,nbl;
  int      eDIM = V[0]->flist[0]->dim();
  Bsystem *PB   = Vbsys[eDIM],*B = Vbsys[0];
  int      nel  = B->nel,info;
  int      **ipiv    = B->Gmat->cipiv;
  double   **binvc   = B->Gmat->binvc;
  double   **invc    = B->Gmat->invc;
  double   ***dbinvc = B->Gmat->dbinvc;
  double   **p_binvc  = PB->Gmat->binvc;
  Element  *E,*E1;
  Bndry    *Ebc;
  double   *tmp;

  if(eDIM == 2)
    tmp = dvector(0,max(8*LGmax,(LGmax-2)*(LGmax-2)));
  else
    tmp = dvector(0,18*LGmax*LGmax);

  B  = Vbsys[0];
  PB = Vbsys[eDIM];

#ifdef __LIBCATAMOUNT__
  st1 = dclock();
#else
  st1 = clock();
#endif

  /* save initial condition */
  saveinit(V,u0,Vbsys);
  Timing1("saveinit..........");

  /* take inner product if in physical space */
  for(i = 0; i < eDIM; ++i){
    if(Vf[i]->fhead->state == 'p')
      Vf[i]->Iprod(Vf[i]);
  }

  /* zero pressure field */
  dzero(Vf[eDIM]->hjtot,Vf[eDIM]->base_hj,1);
  Timing1("zeroing...........");

  /* condense out interior from u-vel + p */
  for(i = 0; i < eDIM; ++i)
    for(E=Vf[i]->fhead;E;E=E->next){
      nbl = E->Nbmodes;
      N   = E->Nmodes - nbl;
      if(N)
  dgemv('T', N, nbl, -1., binvc[E->geom->id], N,
      E->vert->hj+nbl, 1, 1., E->vert->hj,1);
    }
  Timing1("first condense(v).");

  for(i = 0; i < eDIM; ++i)
    for(E=Vf[i]->fhead;E;E=E->next){
      nbl = E->Nbmodes;
      N   = E->Nmodes - nbl;
      if(N) {
  E1 = Vf[eDIM]->flist[E->id];
  if(B->lambda->wave){
    dcopy(N,E->vert->hj+nbl,1,tmp,1);
    dgetrs('N', N, 1, invc[E->geom->id], N,ipiv[E->geom->id],tmp,N,info);
    dgemv('T', N, E1->Nmodes, -1., dbinvc[i][E->geom->id], N,
    tmp, 1, 1., E1->vert->hj,1);
  }
  else{
     dgemv('T', N, E1->Nmodes, -1., dbinvc[i][E->geom->id], N,
    E->vert->hj+nbl, 1, 1., E1->vert->hj,1);
  }
      }
   }

  Timing1("first condense(p).");

  /* add flux terms */
  for(i = 0; i < eDIM; ++i)
    for(Ebc = Vbc[i]; Ebc; Ebc = Ebc->next)
      if(Ebc->type == 'F' || Ebc->type == 'R')
  Vf[i]->flist[Ebc->elmt->id]->Add_flux_terms(Ebc);

  /* second level of factorisation to orthogonalise basis to p */
  for(E=Vf[eDIM]->fhead;E;E=E->next){

    E1 = Vf[0]->flist[E->id];

    nbl = eDIM*E1->Nbmodes + 1;
    N   = E->Nmodes-1;

    dgemv('T', N, nbl, -1.0, p_binvc[E->geom->id], N,
    E->vert->hj+1, 1, 0.0, tmp,1);

    for(i = 0; i < eDIM; ++i){
      E1 = Vf[i]->flist[E->id];
      dvadd(E1->Nbmodes,tmp+i*E1->Nbmodes,1,E1->vert->hj,1,E1->vert->hj,1);
    }

    E->vert->hj[0] += tmp[nbl-1];
  }

  Timing1("second condense...");

  /* subtract boundary initial conditions */
  if(PB->smeth == iterative){
    double **wk;
    double **a = PB->Gmat->a;

    if(eDIM == 2)
      wk = dmatrix(0,1,0,eDIM*4*LGmax);
    else
      wk = dmatrix(0,1,0,eDIM*6*LGmax*LGmax);

    for(k = 0; k < nel; ++k){
      nbl = V[0]->flist[k]->Nbmodes;

      /* gather vector */
      for(i = 0; i < eDIM; ++i)
  dcopy(nbl,V[i]->flist[k]->vert->hj,1,wk[0]+i*nbl,1);

      dspmv('U',eDIM*nbl+1,1.0,a[V[0]->flist[k]->geom->id],
    wk[0],1,0.0,wk[1],1);

      /* subtract of Vf */
      for(i = 0; i < eDIM; ++i)
  dvsub(nbl,Vf[i]->flist[k]->vert->hj,1,wk[1]+i*nbl,1,
        Vf[i]->flist[k]->vert->hj,1);
      Vf[eDIM]->flist[k]->vert->hj[0] -= wk[1][eDIM*nbl];
    }

    GathrBndry_Stokes(Vf,rhs,Vbsys);

    free_dmatrix(wk,0,0);
  }
  else{
    if(Vbc[0]->DirRHS){
      GathrBndry_Stokes(Vf,rhs,Vbsys);

      /* subtract of bcs */
      dvsub(PB->nsolve,rhs,1,Vbc[0]->DirRHS,1,rhs,1);

      /* zero ic vector */
      dzero(PB->nsolve,u0,1);
    }
    else{

      /* zero out interior components since only deal with boundary initial
   conditions (interior is always direct) */

      for(i = 0; i < eDIM; ++i)
  for(E = V[i]->fhead; E; E = E->next){
    nbl = E->Nbmodes;
    N   = E->Nmodes - nbl;
    dzero(N, E->vert->hj + nbl, 1);
  }

      /* inner product of divergence for pressure forcing */
      for(i = 0; i < eDIM; ++i)
  V[i]->Trans(V[i], J_to_Q);

      V[0]->Grad(V[eDIM],0,0,'x');
      V[1]->Grad(0,Vf[eDIM],0,'y');
      dvadd(V[1]->htot,V[eDIM]->base_h,1,Vf[eDIM]->base_h,1,
      V[eDIM]->base_h,1);

      if(eDIM == 3){
  V[2]->Grad(0,V[eDIM],0,'z');
  dvadd(V[2]->htot,V[eDIM]->base_h,1,Vf[eDIM]->base_h,1,
        V[eDIM]->base_h,1);
      }

#ifndef PCONTBASE
      for(k = 0; k < nel; ++k)
  V[eDIM]->flist[k]->Ofwd(*V[eDIM]->flist[k]->h,
        V[eDIM]->flist[k]->vert->hj,
        V[eDIM]->flist[k]->dgL);
#else
      V[eDIM]->Iprod(V[eDIM]);
#endif

      for(i = 0; i < eDIM; ++i){
  for(k = 0; k < nel; ++k){
    E   = V[i]->flist[k];
    nbl = E->Nbmodes;
    N   = E->Nmodes - nbl;

    E->HelmHoltz(PB->lambda+k);

    dscal(E->Nmodes, -B->lambda[k].d, E->vert->hj, 1);

    if(N) {
      /* condense out interior terms in velocity */
      dgemv('T', N, nbl, -1., binvc[E->geom->id], N,
      E->vert->hj+nbl, 1, 1., E->vert->hj,1);

      /* condense out interior terms in pressure*/
      E1 = V[eDIM]->flist[k];
      if(B->lambda->wave){
        dcopy(N,E->vert->hj+nbl,1,tmp,1);
        dgetrs('N',N,1,invc[E->geom->id],N,ipiv[E->geom->id],tmp,N,info);
        dgemv('T', N, E1->Nmodes, -1., dbinvc[i][E->geom->id], N,
        tmp, 1, 1., E1->vert->hj,1);
      }
      else{
        dgemv('T', N, E1->Nmodes, -1., dbinvc[i][E->geom->id], N,
        E->vert->hj+nbl, 1, 1., E1->vert->hj,1);
      }
    }
  }
      }

      /* second level of factorisation to orthogonalise basis to  p */
      /* p - vel */
      for(E=V[eDIM]->fhead;E;E=E->next){

  E1 = V[0]->flist[E->id];

  nbl = eDIM*E1->Nbmodes + 1;
  N   = E->Nmodes-1;

  dgemv('T', N, nbl, -1.0, p_binvc[E->geom->id], N,
        E->vert->hj+1, 1, 0.0, tmp,1);

  for(i = 0; i < eDIM; ++i){
    E1 = V[i]->flist[E->id];
    dvadd(E1->Nbmodes,tmp+i*E1->Nbmodes,1,E1->vert->hj,1,E1->vert->hj,1);
    dvadd(E1->Nbmodes,E1->vert->hj,1,Vf[i]->flist[E->id]->vert->hj,1,
    Vf[i]->flist[E->id]->vert->hj,1);
  }

  Vf[eDIM]->flist[E->id]->vert->hj[0] += E->vert->hj[0] + tmp[nbl-1];
      }
      Timing1("bc condense.......");

      GathrBndry_Stokes(Vf,rhs,Vbsys);
      Timing1("GatherBndry.......");
    }
  }

  /* finally copy inner product of f into v for inner solve */
  for(i = 0; i < eDIM; ++i)
    for(E  = V[i]->fhead; E; E= E->next){
      nbl = E->Nbmodes;
      N   = E->Nmodes - nbl;
      E1 = Vf[i]->flist[E->id];
      dcopy(N, E1->vert->hj+nbl, 1, E->vert->hj+nbl, 1);
    }
  for(E = Vf[eDIM]->fhead; E; E = E->next){
    E1 = V[eDIM]->flist[E->id];
    dcopy(E->Nmodes,E->vert->hj,1,E1->vert->hj,1);
  }

  dzero(PB->nglobal-PB->nsolve, rhs + PB->nsolve, 1);

  free(tmp);
}