/* the initial function */
PetscReal f_ini(PetscReal x,PetscReal y)
{
PetscReal f;
f=PetscExpReal(-20.0*(PetscPowRealInt(x-0.5,2)+PetscPowRealInt(y-0.5,2)));
return f;
}
static PetscErrorCode FormRHSFunction(TS ts,PetscReal t,Vec X,Vec F,void *ptr)
{
User user = (User)ptr;
DM da;
Vec Xloc;
DMDALocalInfo info;
PetscInt i,j;
PetscReal hx;
Field *f;
const Field *x;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(da,&info);CHKERRQ(ierr);
hx = 1.0/(PetscReal)info.mx;
/*
Scatter ghost points to local vector,using the 2-step process
DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = DMGetLocalVector(da,&Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = DMDAVecGetArrayRead(da,Xloc,(void*)&x);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/* Compute function over the locally owned part of the grid */
for (i=info.xs; i<info.xs+info.xm; i++) {
const PetscReal *a = user->a;
PetscReal u0t[2];
u0t[0] = 1.0 - PetscPowRealInt(PetscSinReal(12*t),4);
u0t[1] = 0.0;
for (j=0; j<2; j++) {
if (i == 0) f[i][j] = a[j]/hx*(1./3*u0t[j] + 0.5*x[i][j] - x[i+1][j] + 1./6*x[i+2][j]);
else if (i == 1) f[i][j] = a[j]/hx*(-1./12*u0t[j] + 2./3*x[i-1][j] - 2./3*x[i+1][j] + 1./12*x[i+2][j]);
else if (i == info.mx-2) f[i][j] = a[j]/hx*(-1./6*x[i-2][j] + x[i-1][j] - 0.5*x[i][j] - 1./3*x[i+1][j]);
else if (i == info.mx-1) f[i][j] = a[j]/hx*(-x[i][j] + x[i-1][j]);
else f[i][j] = a[j]/hx*(-1./12*x[i-2][j] + 2./3*x[i-1][j] - 2./3*x[i+1][j] + 1./12*x[i+2][j]);
}
}
/* Restore vectors */
ierr = DMDAVecRestoreArrayRead(da,Xloc,(void*)&x);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&Xloc);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int Brusselator(int argc,char **argv,PetscInt cycle)
{
TS ts; /* nonlinear solver */
Vec X; /* solution, residual vectors */
Mat J; /* Jacobian matrix */
PetscInt steps,maxsteps,mx;
PetscErrorCode ierr;
DM da;
PetscReal ftime,hx,dt,xmax,xmin;
struct _User user; /* user-defined work context */
TSConvergedReason reason;
PetscInitialize(&argc,&argv,(char*)0,help);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,-11,2,2,NULL,&da);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DMDA;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&X);CHKERRQ(ierr);
/* Initialize user application context */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Advection-reaction options","");
{
user.A = 1;
user.B = 3;
user.alpha = 0.1;
user.uleft = 1;
user.uright = 1;
user.vleft = 3;
user.vright = 3;
ierr = PetscOptionsReal("-A","Reaction rate","",user.A,&user.A,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-B","Reaction rate","",user.B,&user.B,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alpha","Diffusion coefficient","",user.alpha,&user.alpha,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-uleft","Dirichlet boundary condition","",user.uleft,&user.uleft,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-uright","Dirichlet boundary condition","",user.uright,&user.uright,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-vleft","Dirichlet boundary condition","",user.vleft,&user.vleft,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-vright","Dirichlet boundary condition","",user.vright,&user.vright,NULL);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr);
ierr = TSSetType(ts,TSARKIMEX);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,FormRHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,FormIFunction,&user);CHKERRQ(ierr);
ierr = DMSetMatType(da,MATAIJ);CHKERRQ(ierr);
ierr = DMCreateMatrix(da,&J);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,J,J,FormIJacobian,&user);CHKERRQ(ierr);
ftime = 1.0;
maxsteps = 10000;
ierr = TSSetDuration(ts,maxsteps,ftime);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(ts,X,&user);CHKERRQ(ierr);
ierr = TSSetSolution(ts,X);CHKERRQ(ierr);
ierr = VecGetSize(X,&mx);CHKERRQ(ierr);
hx = 1.0/(PetscReal)(mx/2-1);
dt = 0.4 * PetscSqr(hx) / user.alpha; /* Diffusive stability limit */
dt *= PetscPowRealInt(0.2,cycle); /* Shrink the time step in convergence study. */
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSSetTolerances(ts,1e-3*PetscPowRealInt(0.5,cycle),NULL,1e-3*PetscPowRealInt(0.5,cycle),NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,X);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
ierr = TSGetConvergedReason(ts,&reason);CHKERRQ(ierr);
ierr = VecMin(X,NULL,&xmin);CHKERRQ(ierr);
ierr = VecMax(X,NULL,&xmax);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"%s at time %g after % 3D steps. Range [%6.4f,%6.4f]\n",TSConvergedReasons[reason],(double)ftime,steps,(double)xmin,(double)xmax);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
static PetscErrorCode GLLStuffs(DomainData dd, GLLData *glldata)
{
PetscErrorCode ierr;
PetscReal *M,si;
PetscScalar x,z0,z1,z2,Lpj,Lpr,rhoGLj,rhoGLk;
PetscBLASInt pm1,lierr;
PetscInt i,j,n,k,s,r,q,ii,jj,p=dd.p;
PetscInt xloc,yloc,zloc,xyloc,xyzloc;
PetscFunctionBeginUser;
/* Gauss-Lobatto-Legendre nodes zGL on [-1,1] */
ierr = PetscMalloc1(p+1,&glldata->zGL);CHKERRQ(ierr);
ierr = PetscMemzero(glldata->zGL,(p+1)*sizeof(*glldata->zGL));CHKERRQ(ierr);
glldata->zGL[0]=-1.0;
glldata->zGL[p]= 1.0;
if (p > 1) {
if (p == 2) glldata->zGL[1]=0.0;
else {
ierr = PetscMalloc1(p-1,&M);CHKERRQ(ierr);
for (i=0; i<p-1; i++) {
si = (PetscReal)(i+1.0);
M[i]=0.5*PetscSqrtReal(si*(si+2.0)/((si+0.5)*(si+1.5)));
}
pm1 = p-1;
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
PetscStackCallBLAS("LAPACKsteqr",LAPACKsteqr_("N",&pm1,&glldata->zGL[1],M,&x,&pm1,M,&lierr));
if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in STERF Lapack routine %d",(int)lierr);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
ierr = PetscFree(M);CHKERRQ(ierr);
}
}
/* Weights for 1D quadrature */
ierr = PetscMalloc1(p+1,&glldata->rhoGL);CHKERRQ(ierr);
glldata->rhoGL[0]=2.0/(PetscScalar)(p*(p+1.0));
glldata->rhoGL[p]=glldata->rhoGL[0];
z2 = -1; /* Dummy value to avoid -Wmaybe-initialized */
for (i=1; i<p; i++) {
x = glldata->zGL[i];
z0 = 1.0;
z1 = x;
for (n=1; n<p; n++) {
z2 = x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0));
z0 = z1;
z1 = z2;
}
glldata->rhoGL[i]=2.0/(p*(p+1.0)*z2*z2);
}
/* Auxiliary mat for laplacian */
ierr = PetscMalloc1(p+1,&glldata->A);CHKERRQ(ierr);
ierr = PetscMalloc1((p+1)*(p+1),&glldata->A[0]);CHKERRQ(ierr);
for (i=1; i<p+1; i++) glldata->A[i]=glldata->A[i-1]+p+1;
for (j=1; j<p; j++) {
x =glldata->zGL[j];
z0=1.0;
z1=x;
for (n=1; n<p; n++) {
z2=x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0));
z0=z1;
z1=z2;
}
Lpj=z2;
for (r=1; r<p; r++) {
if (r == j) {
glldata->A[j][j]=2.0/(3.0*(1.0-glldata->zGL[j]*glldata->zGL[j])*Lpj*Lpj);
} else {
x = glldata->zGL[r];
z0 = 1.0;
z1 = x;
for (n=1; n<p; n++) {
z2=x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0));
z0=z1;
z1=z2;
}
Lpr = z2;
glldata->A[r][j]=4.0/(p*(p+1.0)*Lpj*Lpr*(glldata->zGL[j]-glldata->zGL[r])*(glldata->zGL[j]-glldata->zGL[r]));
}
}
}
for (j=1; j<p+1; j++) {
x = glldata->zGL[j];
z0 = 1.0;
z1 = x;
for (n=1; n<p; n++) {
z2=x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0));
z0=z1;
z1=z2;
}
Lpj = z2;
glldata->A[j][0]=4.0*PetscPowRealInt(-1.0,p)/(p*(p+1.0)*Lpj*(1.0+glldata->zGL[j])*(1.0+glldata->zGL[j]));
glldata->A[0][j]=glldata->A[j][0];
}
for (j=0; j<p; j++) {
x = glldata->zGL[j];
z0 = 1.0;
z1 = x;
for (n=1; n<p; n++) {
z2=x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0));
z0=z1;
z1=z2;
}
Lpj=z2;
glldata->A[p][j]=4.0/(p*(p+1.0)*Lpj*(1.0-glldata->zGL[j])*(1.0-glldata->zGL[j]));
glldata->A[j][p]=glldata->A[p][j];
}
glldata->A[0][0]=0.5+(p*(p+1.0)-2.0)/6.0;
glldata->A[p][p]=glldata->A[0][0];
/* compute element matrix */
xloc = p+1;
yloc = p+1;
zloc = p+1;
if (dd.dim<2) yloc=1;
if (dd.dim<3) zloc=1;
xyloc = xloc*yloc;
xyzloc = xloc*yloc*zloc;
ierr = MatCreate(PETSC_COMM_SELF,&glldata->elem_mat);CHKERRQ(ierr);
ierr = MatSetSizes(glldata->elem_mat,xyzloc,xyzloc,xyzloc,xyzloc);CHKERRQ(ierr);
ierr = MatSetType(glldata->elem_mat,MATSEQAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(glldata->elem_mat,xyzloc,NULL);CHKERRQ(ierr); /* overestimated */
ierr = MatZeroEntries(glldata->elem_mat);CHKERRQ(ierr);
ierr = MatSetOption(glldata->elem_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
for (k=0; k<zloc; k++) {
if (dd.dim>2) rhoGLk=glldata->rhoGL[k];
else rhoGLk=1.0;
for (j=0; j<yloc; j++) {
if (dd.dim>1) rhoGLj=glldata->rhoGL[j];
else rhoGLj=1.0;
for (i=0; i<xloc; i++) {
ii = k*xyloc+j*xloc+i;
s = k;
r = j;
for (q=0; q<xloc; q++) {
jj = s*xyloc+r*xloc+q;
ierr = MatSetValue(glldata->elem_mat,jj,ii,glldata->A[i][q]*rhoGLj*rhoGLk,ADD_VALUES);CHKERRQ(ierr);
}
if (dd.dim>1) {
s=k;
q=i;
for (r=0; r<yloc; r++) {
jj = s*xyloc+r*xloc+q;
ierr = MatSetValue(glldata->elem_mat,jj,ii,glldata->A[j][r]*glldata->rhoGL[i]*rhoGLk,ADD_VALUES);CHKERRQ(ierr);
}
}
if (dd.dim>2) {
r=j;
q=i;
for (s=0; s<zloc; s++) {
jj = s*xyloc+r*xloc+q;
ierr = MatSetValue(glldata->elem_mat,jj,ii,glldata->A[k][s]*rhoGLj*glldata->rhoGL[i],ADD_VALUES);CHKERRQ(ierr);
}
}
}
}
}
ierr = MatAssemblyBegin(glldata->elem_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (glldata->elem_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
#if DEBUG
{
Vec lvec,rvec;
PetscReal norm;
ierr = MatCreateVecs(glldata->elem_mat,&lvec,&rvec);CHKERRQ(ierr);
ierr = VecSet(lvec,1.0);CHKERRQ(ierr);
ierr = MatMult(glldata->elem_mat,lvec,rvec);CHKERRQ(ierr);
ierr = VecNorm(rvec,NORM_INFINITY,&norm);CHKERRQ(ierr);
printf("Test null space of elem mat % 1.14e\n",norm);
ierr = VecDestroy(&lvec);CHKERRQ(ierr);
ierr = VecDestroy(&rvec);CHKERRQ(ierr);
}
#endif
PetscFunctionReturn(0);
}
static PetscErrorCode ComputeSubdomainMatrix(DomainData dd, GLLData glldata, Mat *local_mat)
{
PetscErrorCode ierr;
PetscInt localsize,zloc,yloc,xloc,auxnex,auxney,auxnez;
PetscInt ie,je,ke,i,j,k,ig,jg,kg,ii,ming;
PetscInt *indexg,*cols,*colsg;
PetscScalar *vals;
Mat temp_local_mat,elem_mat_DBC=0,*usedmat;
IS submatIS;
PetscFunctionBeginUser;
ierr = MatGetSize(glldata.elem_mat,&i,&j);CHKERRQ(ierr);
ierr = PetscMalloc1(i,&indexg);CHKERRQ(ierr);
ierr = PetscMalloc1(i,&colsg);CHKERRQ(ierr);
/* get submatrix of elem_mat without dirichlet nodes */
if (!dd.pure_neumann && !dd.DBC_zerorows && !dd.ipx) {
xloc = dd.p+1;
yloc = 1;
zloc = 1;
if (dd.dim>1) yloc = dd.p+1;
if (dd.dim>2) zloc = dd.p+1;
ii = 0;
for (k=0;k<zloc;k++) {
for (j=0;j<yloc;j++) {
for (i=1;i<xloc;i++) {
indexg[ii]=k*xloc*yloc+j*xloc+i;
ii++;
}
}
}
ierr = ISCreateGeneral(PETSC_COMM_SELF,ii,indexg,PETSC_COPY_VALUES,&submatIS);CHKERRQ(ierr);
ierr = MatGetSubMatrix(glldata.elem_mat,submatIS,submatIS,MAT_INITIAL_MATRIX,&elem_mat_DBC);CHKERRQ(ierr);
ierr = ISDestroy(&submatIS);CHKERRQ(ierr);
}
/* Assemble subdomain matrix */
localsize = dd.xm_l*dd.ym_l*dd.zm_l;
ierr = MatCreate(PETSC_COMM_SELF,&temp_local_mat);CHKERRQ(ierr);
ierr = MatSetSizes(temp_local_mat,localsize,localsize,localsize,localsize);CHKERRQ(ierr);
ierr = MatSetOptionsPrefix(temp_local_mat,"subdomain_");CHKERRQ(ierr);
/* set local matrices type: here we use SEQSBAIJ primarily for testing purpose */
/* in order to avoid conversions inside the BDDC code, use SeqAIJ if possible */
if (dd.DBC_zerorows && !dd.ipx) { /* in this case, we need to zero out some of the rows, so use seqaij */
ierr = MatSetType(temp_local_mat,MATSEQAIJ);CHKERRQ(ierr);
} else {
ierr = MatSetType(temp_local_mat,MATSEQSBAIJ);CHKERRQ(ierr);
}
ierr = MatSetFromOptions(temp_local_mat);CHKERRQ(ierr);
i = PetscPowRealInt(3.0*(dd.p+1.0),dd.dim);
ierr = MatSeqAIJSetPreallocation(temp_local_mat,i,NULL);CHKERRQ(ierr); /* very overestimated */
ierr = MatSeqSBAIJSetPreallocation(temp_local_mat,1,i,NULL);CHKERRQ(ierr); /* very overestimated */
ierr = MatSetOption(temp_local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
yloc = dd.p+1;
zloc = dd.p+1;
if (dd.dim < 3) zloc = 1;
if (dd.dim < 2) yloc = 1;
auxnez = dd.nez_l;
auxney = dd.ney_l;
auxnex = dd.nex_l;
if (dd.dim < 3) auxnez = 1;
if (dd.dim < 2) auxney = 1;
for (ke=0; ke<auxnez; ke++) {
for (je=0; je<auxney; je++) {
for (ie=0; ie<auxnex; ie++) {
/* customize element accounting for BC */
xloc = dd.p+1;
ming = 0;
usedmat = &glldata.elem_mat;
if (!dd.pure_neumann && !dd.DBC_zerorows && !dd.ipx) {
if (ie == 0) {
xloc = dd.p;
usedmat = &elem_mat_DBC;
} else {
ming = -1;
usedmat = &glldata.elem_mat;
}
}
/* local to the element/global to the subdomain indexing */
for (k=0; k<zloc; k++) {
kg = ke*dd.p+k;
for (j=0; j<yloc; j++) {
jg = je*dd.p+j;
for (i=0; i<xloc; i++) {
ig = ie*dd.p+i+ming;
ii = k*xloc*yloc+j*xloc+i;
indexg[ii] = kg*dd.xm_l*dd.ym_l+jg*dd.xm_l+ig;
}
}
}
/* Set values */
for (i=0; i<xloc*yloc*zloc; i++) {
ierr = MatGetRow(*usedmat,i,&j,(const PetscInt**)&cols,(const PetscScalar**)&vals);CHKERRQ(ierr);
for (k=0; k<j; k++) colsg[k] = indexg[cols[k]];
ierr = MatSetValues(temp_local_mat,1,&indexg[i],j,colsg,vals,ADD_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(*usedmat,i,&j,(const PetscInt**)&cols,(const PetscScalar**)&vals);CHKERRQ(ierr);
}
}
}
}
ierr = PetscFree(indexg);CHKERRQ(ierr);
ierr = PetscFree(colsg);CHKERRQ(ierr);
ierr = MatAssemblyBegin(temp_local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (temp_local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
#if DEBUG
{
Vec lvec,rvec;
PetscReal norm;
ierr = MatCreateVecs(temp_local_mat,&lvec,&rvec);CHKERRQ(ierr);
ierr = VecSet(lvec,1.0);CHKERRQ(ierr);
ierr = MatMult(temp_local_mat,lvec,rvec);CHKERRQ(ierr);
ierr = VecNorm(rvec,NORM_INFINITY,&norm);CHKERRQ(ierr);
printf("Test null space of local mat % 1.14e\n",norm);
ierr = VecDestroy(&lvec);CHKERRQ(ierr);
ierr = VecDestroy(&rvec);CHKERRQ(ierr);
}
#endif
*local_mat = temp_local_mat;
ierr = MatDestroy(&elem_mat_DBC);CHKERRQ(ierr);
PetscFunctionReturn(0);
}