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);
}
PetscErrorCode test_solve(void)
{
Mat A11, A12,A21,A22, A, tmp[2][2];
KSP ksp;
PC pc;
Vec b,x, f,h, diag, x1,x2;
Vec tmp_x[2],*_tmp_x;
int n, np, i,j;
PetscErrorCode ierr;
PetscFunctionBeginUser;
PetscPrintf(PETSC_COMM_WORLD, "%s \n", PETSC_FUNCTION_NAME);
n = 3;
np = 2;
/* Create matrices */
/* A11 */
ierr = VecCreate(PETSC_COMM_WORLD, &diag);CHKERRQ(ierr);
ierr = VecSetSizes(diag, PETSC_DECIDE, n);CHKERRQ(ierr);
ierr = VecSetFromOptions(diag);CHKERRQ(ierr);
ierr = VecSet(diag, (1.0/10.0));CHKERRQ(ierr); /* so inverse = diag(10) */
/* As a test, create a diagonal matrix for A11 */
ierr = MatCreate(PETSC_COMM_WORLD, &A11);CHKERRQ(ierr);
ierr = MatSetSizes(A11, PETSC_DECIDE, PETSC_DECIDE, n, n);CHKERRQ(ierr);
ierr = MatSetType(A11, MATAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(A11, n, NULL);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(A11, np, NULL,np, NULL);CHKERRQ(ierr);
ierr = MatDiagonalSet(A11, diag, INSERT_VALUES);CHKERRQ(ierr);
ierr = VecDestroy(&diag);CHKERRQ(ierr);
/* A12 */
ierr = MatCreate(PETSC_COMM_WORLD, &A12);CHKERRQ(ierr);
ierr = MatSetSizes(A12, PETSC_DECIDE, PETSC_DECIDE, n, np);CHKERRQ(ierr);
ierr = MatSetType(A12, MATAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(A12, np, NULL);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(A12, np, NULL,np, NULL);CHKERRQ(ierr);
for (i=0; i<n; i++) {
for (j=0; j<np; j++) {
ierr = MatSetValue(A12, i,j, (PetscScalar)(i+j*n), INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatSetValue(A12, 2,1, (PetscScalar)(4), INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A12, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A12, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* A21 */
ierr = MatTranspose(A12, MAT_INITIAL_MATRIX, &A21);CHKERRQ(ierr);
A22 = NULL;
/* Create block matrix */
tmp[0][0] = A11;
tmp[0][1] = A12;
tmp[1][0] = A21;
tmp[1][1] = A22;
ierr = MatCreateNest(PETSC_COMM_WORLD,2,NULL,2,NULL,&tmp[0][0],&A);CHKERRQ(ierr);
ierr = MatNestSetVecType(A,VECNEST);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Create vectors */
ierr = MatCreateVecs(A12, &h, &f);CHKERRQ(ierr);
ierr = VecSet(f, 1.0);CHKERRQ(ierr);
ierr = VecSet(h, 0.0);CHKERRQ(ierr);
/* Create block vector */
tmp_x[0] = f;
tmp_x[1] = h;
ierr = VecCreateNest(PETSC_COMM_WORLD,2,NULL,tmp_x,&b);CHKERRQ(ierr);
ierr = VecAssemblyBegin(b);CHKERRQ(ierr);
ierr = VecAssemblyEnd(b);CHKERRQ(ierr);
ierr = VecDuplicate(b, &x);CHKERRQ(ierr);
ierr = KSPCreate(PETSC_COMM_WORLD, &ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp, A, A);CHKERRQ(ierr);
ierr = KSPSetType(ksp, "gmres");CHKERRQ(ierr);
ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr);
ierr = PCSetType(pc, "none");CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = KSPSolve(ksp, b, x);CHKERRQ(ierr);
ierr = VecNestGetSubVecs(x,NULL,&_tmp_x);CHKERRQ(ierr);
x1 = _tmp_x[0];
x2 = _tmp_x[1];
PetscPrintf(PETSC_COMM_WORLD, "x1 \n");
PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_ASCII_INFO_DETAIL);CHKERRQ(ierr);
ierr = VecView(x1, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
PetscPrintf(PETSC_COMM_WORLD, "x2 \n");
ierr = VecView(x2, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = MatDestroy(&A11);CHKERRQ(ierr);
ierr = MatDestroy(&A12);CHKERRQ(ierr);
ierr = MatDestroy(&A21);CHKERRQ(ierr);
ierr = VecDestroy(&f);CHKERRQ(ierr);
ierr = VecDestroy(&h);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main( int argc, char **argv )
{
Mat A; /* operator matrix */
Vec x;
EPS eps; /* eigenproblem solver context */
const EPSType type;
PetscReal error, tol, re, im;
PetscScalar kr, ki;
PetscErrorCode ierr;
PetscInt N, n=10, m, i, j, II, Istart, Iend, nev, maxit, its, nconv;
PetscScalar w;
PetscBool flag;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,&flag);CHKERRQ(ierr);
if(!flag) m=n;
N = n*m;
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nFiedler vector of a 2-D regular mesh, N=%d (%dx%d grid)\n\n",N,n,m);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the operator matrix that defines the eigensystem, Ax=kx
In this example, A = L(G), where L is the Laplacian of graph G, i.e.
Lii = degree of node i, Lij = -1 if edge (i,j) exists in G
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,N,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
for( II=Istart; II<Iend; II++ ) {
i = II/n; j = II-i*n;
w = 0.0;
if(i>0) { ierr = MatSetValue(A,II,II-n,-1.0,INSERT_VALUES);CHKERRQ(ierr); w=w+1.0; }
if(i<m-1) { ierr = MatSetValue(A,II,II+n,-1.0,INSERT_VALUES);CHKERRQ(ierr); w=w+1.0; }
if(j>0) { ierr = MatSetValue(A,II,II-1,-1.0,INSERT_VALUES);CHKERRQ(ierr); w=w+1.0; }
if(j<n-1) { ierr = MatSetValue(A,II,II+1,-1.0,INSERT_VALUES);CHKERRQ(ierr); w=w+1.0; }
ierr = MatSetValue(A,II,II,w,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create eigensolver context
*/
ierr = EPSCreate(PETSC_COMM_WORLD,&eps);CHKERRQ(ierr);
/*
Set operators. In this case, it is a standard eigenvalue problem
*/
ierr = EPSSetOperators(eps,A,PETSC_NULL);CHKERRQ(ierr);
ierr = EPSSetProblemType(eps,EPS_HEP);CHKERRQ(ierr);
/*
Select portion of spectrum
*/
ierr = EPSSetWhichEigenpairs(eps,EPS_SMALLEST_REAL);CHKERRQ(ierr);
/*
Set solver parameters at runtime
*/
ierr = EPSSetFromOptions(eps);CHKERRQ(ierr);
/*
Attach deflation space: in this case, the matrix has a constant
nullspace, [1 1 ... 1]^T is the eigenvector of the zero eigenvalue
*/
ierr = MatGetVecs(A,&x,PETSC_NULL);CHKERRQ(ierr);
ierr = VecSet(x,1.0);CHKERRQ(ierr);
ierr = EPSSetDeflationSpace(eps,1,&x);CHKERRQ(ierr);
ierr = VecDestroy(x);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the eigensystem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = EPSSolve(eps);CHKERRQ(ierr);
ierr = EPSGetIterationNumber(eps, &its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %d\n",its);CHKERRQ(ierr);
/*
Optional: Get some information from the solver and display it
*/
ierr = EPSGetType(eps,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Solution method: %s\n\n",type);CHKERRQ(ierr);
ierr = EPSGetDimensions(eps,&nev,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of requested eigenvalues: %d\n",nev);CHKERRQ(ierr);
ierr = EPSGetTolerances(eps,&tol,&maxit);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Stopping condition: tol=%.4g, maxit=%d\n",tol,maxit);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Get number of converged approximate eigenpairs
*/
ierr = EPSGetConverged(eps,&nconv);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of converged approximate eigenpairs: %d\n\n",nconv);
CHKERRQ(ierr);
if (nconv>0) {
/*
Display eigenvalues and relative errors
*/
ierr = PetscPrintf(PETSC_COMM_WORLD,
" k ||Ax-kx||/||kx||\n"
" ----------------- ------------------\n" );CHKERRQ(ierr);
for( i=0; i<nconv; i++ ) {
/*
Get converged eigenpairs: i-th eigenvalue is stored in kr (real part) and
ki (imaginary part)
*/
ierr = EPSGetEigenpair(eps,i,&kr,&ki,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
/*
Compute the relative error associated to each eigenpair
*/
ierr = EPSComputeRelativeError(eps,i,&error);CHKERRQ(ierr);
#ifdef PETSC_USE_COMPLEX
re = PetscRealPart(kr);
im = PetscImaginaryPart(kr);
#else
re = kr;
im = ki;
#endif
if (im!=0.0) {
ierr = PetscPrintf(PETSC_COMM_WORLD," %9f%+9f j %12g\n",re,im,error);CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_WORLD," %12f %12g\n",re,error);CHKERRQ(ierr);
}
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n" );CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = EPSDestroy(eps);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
PetscErrorCode femA(AppCtx *obj,PetscInt nz,PetscScalar *z)
{
PetscInt i,j,il,ip,ipp,ipq,iq,iquad,iqq;
PetscInt nli[num_z][2],indx[num_z];
PetscScalar dd,dl,zip,zipq,zz,bb,bbb,aij;
PetscScalar rquad[num_z][3],dlen[num_z],qdwt[3],add_term;
PetscErrorCode ierr;
/* initializing everything */
for (i=0; i < nz; i++) {
nli[i][0] = 0;
nli[i][1] = 0;
indx[i] = 0;
rquad[i][0] = 0.0;
rquad[i][1] = 0.0;
rquad[i][2] = 0.0;
dlen[i] = 0.0;
} /*end for (i)*/
/* quadrature weights */
qdwt[0] = 1.0/6.0;
qdwt[1] = 4.0/6.0;
qdwt[2] = 1.0/6.0;
/* 1st and last nodes have Dirichlet boundary condition -
set indices there to -1 */
for (i=0; i < nz-1; i++) indx[i]=i-1;
indx[nz-1]=-1;
ipq = 0;
for (il=0; il < nz-1; il++) {
ip = ipq;
ipq = ip+1;
zip = z[ip];
zipq = z[ipq];
dl = zipq-zip;
rquad[il][0] = zip;
rquad[il][1] = (0.5)*(zip+zipq);
rquad[il][2] = zipq;
dlen[il] = fabs(dl);
nli[il][0] = ip;
nli[il][1] = ipq;
} /*end for (il)*/
for (il=0; il < nz-1; il++) {
for (iquad=0; iquad < 3; iquad++) {
dd = (dlen[il])*(qdwt[iquad]);
zz = rquad[il][iquad];
for (iq=0; iq < 2; iq++) {
ip = nli[il][iq];
bb = bspl(z,zz,il,iq,nli,1);
i = indx[ip];
if (i > -1) {
for (iqq=0; iqq < 2; iqq++) {
ipp = nli[il][iqq];
bbb = bspl(z,zz,il,iqq,nli,1);
j = indx[ipp];
aij = bb*bbb;
if (j > -1) {
add_term = aij*dd;
ierr = MatSetValue(obj->Amat,i,j,add_term,ADD_VALUES);CHKERRQ(ierr);
}/*endif*/
} /*end for (iqq)*/
} /*end if (i>0)*/
} /*end for (iq)*/
} /*end for (iquad)*/
} /*end for (il)*/
ierr = MatAssemblyBegin(obj->Amat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(obj->Amat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
return 0;
}
/*
* time_step solves for the time_dependence of the system
* that was previously setup using the add_to_ham and add_lin
* routines. Solver selection and parameters can be controlled via PETSc
* command line options. Default solver is TSRK3BS
*
* Inputs:
* Vec x: The density matrix, with appropriate inital conditions
* double dt: initial timestep. For certain explicit methods, this timestep
* can be changed, as those methods have adaptive time steps
* double time_max: the maximum time to integrate to
* int steps_max: max number of steps to take
*/
void time_step(Vec x, PetscReal init_time, PetscReal time_max,PetscReal dt,PetscInt steps_max){
PetscViewer mat_view;
TS ts; /* timestepping context */
PetscInt i,j,Istart,Iend,steps,row,col;
PetscScalar mat_tmp;
PetscReal tmp_real;
Mat AA;
PetscInt nevents,direction;
PetscBool terminate;
operator op;
int num_pop;
double *populations;
Mat solve_A,solve_stiff_A;
PetscLogStagePop();
PetscLogStagePush(solve_stage);
if (_lindblad_terms) {
if (nid==0) {
printf("Lindblad terms found, using Lindblad solver.\n");
}
solve_A = full_A;
if (_stiff_solver) {
if(nid==0) printf("ERROR! Lindblad-stiff solver untested.");
exit(0);
}
} else {
if (nid==0) {
printf("No Lindblad terms found, using (more efficient) Schrodinger solver.\n");
}
solve_A = ham_A;
solve_stiff_A = ham_stiff_A;
if (_num_time_dep&&_stiff_solver) {
if(nid==0) printf("ERROR! Schrodinger-stiff + timedep solver untested.");
exit(0);
}
}
/* Possibly print dense ham. No stabilization is needed? */
if (nid==0) {
/* Print dense ham, if it was asked for */
if (_print_dense_ham){
FILE *fp_ham;
fp_ham = fopen("ham","w");
if (nid==0){
for (i=0;i<total_levels;i++){
for (j=0;j<total_levels;j++){
fprintf(fp_ham,"%e %e ",PetscRealPart(_hamiltonian[i][j]),PetscImaginaryPart(_hamiltonian[i][j]));
}
fprintf(fp_ham,"\n");
}
}
fclose(fp_ham);
for (i=0;i<total_levels;i++){
free(_hamiltonian[i]);
}
free(_hamiltonian);
_print_dense_ham = 0;
}
}
/* Remove stabilization if it was previously added */
if (stab_added){
if (nid==0) printf("Removing stabilization...\n");
/*
* We add 1.0 in the 0th spot and every n+1 after
*/
if (nid==0) {
row = 0;
for (i=0;i<total_levels;i++){
col = i*(total_levels+1);
mat_tmp = -1.0 + 0.*PETSC_i;
MatSetValue(full_A,row,col,mat_tmp,ADD_VALUES);
}
}
}
MatGetOwnershipRange(solve_A,&Istart,&Iend);
/*
* Explicitly add 0.0 to all diagonal elements;
* this fixes a 'matrix in wrong state' message that PETSc
* gives if the diagonal was never initialized.
*/
//if (nid==0) printf("Adding 0 to diagonal elements...\n");
for (i=Istart;i<Iend;i++){
mat_tmp = 0 + 0.*PETSC_i;
MatSetValue(solve_A,i,i,mat_tmp,ADD_VALUES);
}
if(_stiff_solver){
MatGetOwnershipRange(solve_stiff_A,&Istart,&Iend);
for (i=Istart;i<Iend;i++){
mat_tmp = 0 + 0.*PETSC_i;
MatSetValue(solve_stiff_A,i,i,mat_tmp,ADD_VALUES);
}
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*
* Create the timestepping solver and set various options *
*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
* Create timestepping solver context
*/
TSCreate(PETSC_COMM_WORLD,&ts);
TSSetProblemType(ts,TS_LINEAR);
/*
* Set function to get information at every timestep
*/
if (_ts_monitor!=NULL){
TSMonitorSet(ts,_ts_monitor,_tsctx,NULL);
}
/*
* Set up ODE system
*/
TSSetRHSFunction(ts,NULL,TSComputeRHSFunctionLinear,NULL);
if(_stiff_solver) {
/* TSSetIFunction(ts,NULL,TSComputeRHSFunctionLinear,NULL); */
if (nid==0) {
printf("Stiff solver not implemented!\n");
exit(0);
}
if(nid==0) printf("Using stiff solver - TSROSW\n");
}
if(_num_time_dep+_num_time_dep_lin) {
for(i=0;i<_num_time_dep;i++){
tmp_real = 0.0;
_add_ops_to_mat_ham(tmp_real,solve_A,_time_dep_list[i].num_ops,_time_dep_list[i].ops);
}
for(i=0;i<_num_time_dep_lin;i++){
tmp_real = 0.0;
_add_ops_to_mat_lin(tmp_real,solve_A,_time_dep_list_lin[i].num_ops,_time_dep_list_lin[i].ops);
}
/* Tell PETSc to assemble the matrix */
MatAssemblyBegin(solve_A,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(solve_A,MAT_FINAL_ASSEMBLY);
if (nid==0) printf("Matrix Assembled.\n");
MatDuplicate(solve_A,MAT_COPY_VALUES,&AA);
MatAssemblyBegin(AA,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(AA,MAT_FINAL_ASSEMBLY);
TSSetRHSJacobian(ts,AA,AA,_RHS_time_dep_ham_p,NULL);
} else {
/* Tell PETSc to assemble the matrix */
MatAssemblyBegin(solve_A,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(solve_A,MAT_FINAL_ASSEMBLY);
if (_stiff_solver){
MatAssemblyBegin(solve_stiff_A,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(solve_stiff_A,MAT_FINAL_ASSEMBLY);
/* TSSetIJacobian(ts,solve_stiff_A,solve_stiff_A,TSComputeRHSJacobianConstant,NULL); */
if (nid==0) {
printf("Stiff solver not implemented!\n");
exit(0);
}
}
if (nid==0) printf("Matrix Assembled.\n");
TSSetRHSJacobian(ts,solve_A,solve_A,TSComputeRHSJacobianConstant,NULL);
}
/* Print information about the matrix. */
PetscViewerASCIIOpen(PETSC_COMM_WORLD,NULL,&mat_view);
PetscViewerPushFormat(mat_view,PETSC_VIEWER_ASCII_INFO);
/* PetscViewerPushFormat(mat_view,PETSC_VIEWER_ASCII_MATLAB); */
/* MatView(solve_A,mat_view); */
/* PetscInt ncols; */
/* const PetscInt *cols; */
/* const PetscScalar *vals; */
/* for(i=0;i<total_levels*total_levels;i++){ */
/* MatGetRow(solve_A,i,&ncols,&cols,&vals); */
/* for (j=0;j<ncols;j++){ */
/* if(PetscAbsComplex(vals[j])>1e-5){ */
/* printf("%d %d %lf %lf\n",i,cols[j],vals[j]); */
/* } */
/* } */
/* MatRestoreRow(solve_A,i,&ncols,&cols,&vals); */
/* } */
if(_stiff_solver){
MatView(solve_stiff_A,mat_view);
}
PetscViewerPopFormat(mat_view);
PetscViewerDestroy(&mat_view);
TSSetTimeStep(ts,dt);
/*
* Set default options, can be changed at runtime
*/
TSSetMaxSteps(ts,steps_max);
TSSetMaxTime(ts,time_max);
TSSetTime(ts,init_time);
TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);
if (_stiff_solver) {
TSSetType(ts,TSROSW);
} else {
TSSetType(ts,TSRK);
TSRKSetType(ts,TSRK3BS);
}
/* If we have gates to apply, set up the event handler. */
if (_num_quantum_gates > 0) {
nevents = 1; //Only one event for now (did we cross a gate?)
direction = -1; //We only want to count an event if we go from positive to negative
terminate = PETSC_FALSE; //Keep time stepping after we passed our event
/* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate,
* a function to check event status, a function to apply events, private data context.
*/
TSSetEventHandler(ts,nevents,&direction,&terminate,_QG_EventFunction,_QG_PostEventFunction,NULL);
}
if (_num_circuits > 0) {
nevents = 1; //Only one event for now (did we cross a gate?)
direction = -1; //We only want to count an event if we go from positive to negative
terminate = PETSC_FALSE; //Keep time stepping after we passed our event
/* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate,
* a function to check event status, a function to apply events, private data context.
*/
TSSetEventHandler(ts,nevents,&direction,&terminate,_QC_EventFunction,_QC_PostEventFunction,NULL);
}
if (_discrete_ec > 0) {
nevents = 1; //Only one event for now (did we cross an ec step?)
direction = -1; //We only want to count an event if we go from positive to negative
terminate = PETSC_FALSE; //Keep time stepping after we passed our event
/* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate,
* a function to check event status, a function to apply events, private data context.
*/
TSSetEventHandler(ts,nevents,&direction,&terminate,_DQEC_EventFunction,_DQEC_PostEventFunction,NULL);
}
/* if (_lindblad_terms) { */
/* nevents = 1; //Only one event for now (did we cross a gate?) */
/* direction = 0; //We only want to count an event if we go from positive to negative */
/* terminate = PETSC_FALSE; //Keep time stepping after we passed our event */
/* TSSetEventHandler(ts,nevents,&direction,&terminate,_Normalize_EventFunction,_Normalize_PostEventFunction,NULL); */
/* } */
TSSetFromOptions(ts);
TSSolve(ts,x);
TSGetStepNumber(ts,&steps);
num_pop = get_num_populations();
populations = malloc(num_pop*sizeof(double));
get_populations(x,&populations);
/* if(nid==0){ */
/* printf("Final populations: "); */
/* for(i=0;i<num_pop;i++){ */
/* printf(" %e ",populations[i]); */
/* } */
/* printf("\n"); */
/* } */
/* PetscPrintf(PETSC_COMM_WORLD,"Steps %D\n",steps); */
/* Free work space */
TSDestroy(&ts);
if(_num_time_dep+_num_time_dep_lin){
MatDestroy(&AA);
}
free(populations);
PetscLogStagePop();
PetscLogStagePush(post_solve_stage);
return;
}
PetscErrorCode PCBDDCSetupFETIDPMatContext(FETIDPMat_ctx fetidpmat_ctx )
{
PetscErrorCode ierr;
PC_IS *pcis=(PC_IS*)fetidpmat_ctx->pc->data;
PC_BDDC *pcbddc=(PC_BDDC*)fetidpmat_ctx->pc->data;
PCBDDCGraph mat_graph=pcbddc->mat_graph;
Mat_IS *matis = (Mat_IS*)fetidpmat_ctx->pc->pmat->data;
MPI_Comm comm;
Mat ScalingMat;
Vec lambda_global;
IS IS_l2g_lambda;
PetscBool skip_node,fully_redundant;
PetscInt i,j,k,s,n_boundary_dofs,n_global_lambda,n_vertices,partial_sum;
PetscInt n_local_lambda,n_lambda_for_dof,dual_size,n_neg_values,n_pos_values;
PetscMPIInt rank,size,buf_size,neigh;
PetscScalar scalar_value;
PetscInt *vertex_indices;
PetscInt *dual_dofs_boundary_indices,*aux_local_numbering_1,*aux_global_numbering;
PetscInt *aux_sums,*cols_B_delta,*l2g_indices;
PetscScalar *array,*scaling_factors,*vals_B_delta;
PetscInt *aux_local_numbering_2;
/* For communication of scaling factors */
PetscInt *ptrs_buffer,neigh_position;
PetscScalar **all_factors,*send_buffer,*recv_buffer;
MPI_Request *send_reqs,*recv_reqs;
/* tests */
Vec test_vec;
PetscBool test_fetidp;
PetscViewer viewer;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)(fetidpmat_ctx->pc),&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
/* Default type of lagrange multipliers is non-redundant */
fully_redundant = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-fetidp_fullyredundant",&fully_redundant,NULL);CHKERRQ(ierr);
/* Evaluate local and global number of lagrange multipliers */
ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
n_local_lambda = 0;
partial_sum = 0;
n_boundary_dofs = 0;
s = 0;
/* Get Vertices used to define the BDDC */
ierr = PCBDDCGetPrimalVerticesLocalIdx(fetidpmat_ctx->pc,&n_vertices,&vertex_indices);CHKERRQ(ierr);
dual_size = pcis->n_B-n_vertices;
ierr = PetscSortInt(n_vertices,vertex_indices);CHKERRQ(ierr);
ierr = PetscMalloc1(dual_size,&dual_dofs_boundary_indices);CHKERRQ(ierr);
ierr = PetscMalloc1(dual_size,&aux_local_numbering_1);CHKERRQ(ierr);
ierr = PetscMalloc1(dual_size,&aux_local_numbering_2);CHKERRQ(ierr);
ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
for (i=0;i<pcis->n;i++){
j = mat_graph->count[i]; /* RECALL: mat_graph->count[i] does not count myself */
if ( j > 0 ) {
n_boundary_dofs++;
}
skip_node = PETSC_FALSE;
if ( s < n_vertices && vertex_indices[s]==i) { /* it works for a sorted set of vertices */
skip_node = PETSC_TRUE;
s++;
}
if (j < 1) {
skip_node = PETSC_TRUE;
}
if ( !skip_node ) {
if (fully_redundant) {
/* fully redundant set of lagrange multipliers */
n_lambda_for_dof = (j*(j+1))/2;
} else {
n_lambda_for_dof = j;
}
n_local_lambda += j;
/* needed to evaluate global number of lagrange multipliers */
array[i]=(1.0*n_lambda_for_dof)/(j+1.0); /* already scaled for the next global sum */
/* store some data needed */
dual_dofs_boundary_indices[partial_sum] = n_boundary_dofs-1;
aux_local_numbering_1[partial_sum] = i;
aux_local_numbering_2[partial_sum] = n_lambda_for_dof;
partial_sum++;
}
}
ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecSum(pcis->vec1_global,&scalar_value);CHKERRQ(ierr);
fetidpmat_ctx->n_lambda = (PetscInt)PetscRealPart(scalar_value);
/* compute global ordering of lagrange multipliers and associate l2g map */
ierr = PCBDDCSubsetNumbering(comm,matis->mapping,partial_sum,aux_local_numbering_1,aux_local_numbering_2,&i,&aux_global_numbering);CHKERRQ(ierr);
if (i != fetidpmat_ctx->n_lambda) {
SETERRQ3(PETSC_COMM_WORLD,PETSC_ERR_PLIB,"Error in %s: global number of multipliers mismatch! (%d!=%d)\n",__FUNCT__,fetidpmat_ctx->n_lambda,i);
}
ierr = PetscFree(aux_local_numbering_2);CHKERRQ(ierr);
/* init data for scaling factors exchange */
partial_sum = 0;
j = 0;
ierr = PetscMalloc1(pcis->n_neigh,&ptrs_buffer);CHKERRQ(ierr);
ierr = PetscMalloc1(pcis->n_neigh-1,&send_reqs);CHKERRQ(ierr);
ierr = PetscMalloc1(pcis->n_neigh-1,&recv_reqs);CHKERRQ(ierr);
ierr = PetscMalloc1(pcis->n,&all_factors);CHKERRQ(ierr);
ptrs_buffer[0]=0;
for (i=1;i<pcis->n_neigh;i++) {
partial_sum += pcis->n_shared[i];
ptrs_buffer[i] = ptrs_buffer[i-1]+pcis->n_shared[i];
}
ierr = PetscMalloc1(partial_sum,&send_buffer);CHKERRQ(ierr);
ierr = PetscMalloc1(partial_sum,&recv_buffer);CHKERRQ(ierr);
ierr = PetscMalloc1(partial_sum,&all_factors[0]);CHKERRQ(ierr);
for (i=0;i<pcis->n-1;i++) {
j = mat_graph->count[i];
all_factors[i+1]=all_factors[i]+j;
}
/* scatter B scaling to N vec */
ierr = VecScatterBegin(pcis->N_to_B,pcis->D,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(pcis->N_to_B,pcis->D,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
/* communications */
ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
for (i=1;i<pcis->n_neigh;i++) {
for (j=0;j<pcis->n_shared[i];j++) {
send_buffer[ptrs_buffer[i-1]+j]=array[pcis->shared[i][j]];
}
ierr = PetscMPIIntCast(ptrs_buffer[i]-ptrs_buffer[i-1],&buf_size);CHKERRQ(ierr);
ierr = PetscMPIIntCast(pcis->neigh[i],&neigh);CHKERRQ(ierr);
ierr = MPI_Isend(&send_buffer[ptrs_buffer[i-1]],buf_size,MPIU_SCALAR,neigh,0,comm,&send_reqs[i-1]);CHKERRQ(ierr);
ierr = MPI_Irecv(&recv_buffer[ptrs_buffer[i-1]],buf_size,MPIU_SCALAR,neigh,0,comm,&recv_reqs[i-1]);CHKERRQ(ierr);
}
ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
ierr = MPI_Waitall((pcis->n_neigh-1),recv_reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
/* put values in correct places */
for (i=1;i<pcis->n_neigh;i++) {
for (j=0;j<pcis->n_shared[i];j++) {
k = pcis->shared[i][j];
neigh_position = 0;
while(mat_graph->neighbours_set[k][neigh_position] != pcis->neigh[i]) {neigh_position++;}
all_factors[k][neigh_position]=recv_buffer[ptrs_buffer[i-1]+j];
}
}
ierr = MPI_Waitall((pcis->n_neigh-1),send_reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
ierr = PetscFree(send_reqs);CHKERRQ(ierr);
ierr = PetscFree(recv_reqs);CHKERRQ(ierr);
ierr = PetscFree(send_buffer);CHKERRQ(ierr);
ierr = PetscFree(recv_buffer);CHKERRQ(ierr);
ierr = PetscFree(ptrs_buffer);CHKERRQ(ierr);
/* Compute B and B_delta (local actions) */
ierr = PetscMalloc1(pcis->n_neigh,&aux_sums);CHKERRQ(ierr);
ierr = PetscMalloc1(n_local_lambda,&l2g_indices);CHKERRQ(ierr);
ierr = PetscMalloc1(n_local_lambda,&vals_B_delta);CHKERRQ(ierr);
ierr = PetscMalloc1(n_local_lambda,&cols_B_delta);CHKERRQ(ierr);
ierr = PetscMalloc1(n_local_lambda,&scaling_factors);CHKERRQ(ierr);
n_global_lambda=0;
partial_sum=0;
for (i=0;i<dual_size;i++) {
n_global_lambda = aux_global_numbering[i];
j = mat_graph->count[aux_local_numbering_1[i]];
aux_sums[0]=0;
for (s=1;s<j;s++) {
aux_sums[s]=aux_sums[s-1]+j-s+1;
}
array = all_factors[aux_local_numbering_1[i]];
n_neg_values = 0;
while(n_neg_values < j && mat_graph->neighbours_set[aux_local_numbering_1[i]][n_neg_values] < rank) {n_neg_values++;}
n_pos_values = j - n_neg_values;
if (fully_redundant) {
for (s=0;s<n_neg_values;s++) {
l2g_indices [partial_sum+s]=aux_sums[s]+n_neg_values-s-1+n_global_lambda;
cols_B_delta [partial_sum+s]=dual_dofs_boundary_indices[i];
vals_B_delta [partial_sum+s]=-1.0;
scaling_factors[partial_sum+s]=array[s];
}
for (s=0;s<n_pos_values;s++) {
l2g_indices [partial_sum+s+n_neg_values]=aux_sums[n_neg_values]+s+n_global_lambda;
cols_B_delta [partial_sum+s+n_neg_values]=dual_dofs_boundary_indices[i];
vals_B_delta [partial_sum+s+n_neg_values]=1.0;
scaling_factors[partial_sum+s+n_neg_values]=array[s+n_neg_values];
}
partial_sum += j;
} else {
/* l2g_indices and default cols and vals of B_delta */
for (s=0;s<j;s++) {
l2g_indices [partial_sum+s]=n_global_lambda+s;
cols_B_delta [partial_sum+s]=dual_dofs_boundary_indices[i];
vals_B_delta [partial_sum+s]=0.0;
}
/* B_delta */
if ( n_neg_values > 0 ) { /* there's a rank next to me to the left */
vals_B_delta [partial_sum+n_neg_values-1]=-1.0;
}
if ( n_neg_values < j ) { /* there's a rank next to me to the right */
vals_B_delta [partial_sum+n_neg_values]=1.0;
}
/* scaling as in Klawonn-Widlund 1999*/
for (s=0;s<n_neg_values;s++) {
scalar_value = 0.0;
for (k=0;k<s+1;k++) {
scalar_value += array[k];
}
scaling_factors[partial_sum+s] = -scalar_value;
}
for (s=0;s<n_pos_values;s++) {
scalar_value = 0.0;
for (k=s+n_neg_values;k<j;k++) {
scalar_value += array[k];
}
scaling_factors[partial_sum+s+n_neg_values] = scalar_value;
}
partial_sum += j;
}
}
ierr = PetscFree(aux_global_numbering);CHKERRQ(ierr);
ierr = PetscFree(aux_sums);CHKERRQ(ierr);
ierr = PetscFree(aux_local_numbering_1);CHKERRQ(ierr);
ierr = PetscFree(dual_dofs_boundary_indices);CHKERRQ(ierr);
ierr = PetscFree(all_factors[0]);CHKERRQ(ierr);
ierr = PetscFree(all_factors);CHKERRQ(ierr);
/* Local to global mapping of fetidpmat */
ierr = VecCreate(PETSC_COMM_SELF,&fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
ierr = VecSetSizes(fetidpmat_ctx->lambda_local,n_local_lambda,n_local_lambda);CHKERRQ(ierr);
ierr = VecSetType(fetidpmat_ctx->lambda_local,VECSEQ);CHKERRQ(ierr);
ierr = VecCreate(comm,&lambda_global);CHKERRQ(ierr);
ierr = VecSetSizes(lambda_global,PETSC_DECIDE,fetidpmat_ctx->n_lambda);CHKERRQ(ierr);
ierr = VecSetType(lambda_global,VECMPI);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,n_local_lambda,l2g_indices,PETSC_OWN_POINTER,&IS_l2g_lambda);CHKERRQ(ierr);
ierr = VecScatterCreate(fetidpmat_ctx->lambda_local,(IS)0,lambda_global,IS_l2g_lambda,&fetidpmat_ctx->l2g_lambda);CHKERRQ(ierr);
ierr = ISDestroy(&IS_l2g_lambda);CHKERRQ(ierr);
/* Create local part of B_delta */
ierr = MatCreate(PETSC_COMM_SELF,&fetidpmat_ctx->B_delta);
ierr = MatSetSizes(fetidpmat_ctx->B_delta,n_local_lambda,pcis->n_B,n_local_lambda,pcis->n_B);CHKERRQ(ierr);
ierr = MatSetType(fetidpmat_ctx->B_delta,MATSEQAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(fetidpmat_ctx->B_delta,1,NULL);CHKERRQ(ierr);
ierr = MatSetOption(fetidpmat_ctx->B_delta,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
for (i=0;i<n_local_lambda;i++) {
ierr = MatSetValue(fetidpmat_ctx->B_delta,i,cols_B_delta[i],vals_B_delta[i],INSERT_VALUES);CHKERRQ(ierr);
}
ierr = PetscFree(vals_B_delta);CHKERRQ(ierr);
ierr = MatAssemblyBegin(fetidpmat_ctx->B_delta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (fetidpmat_ctx->B_delta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (fully_redundant) {
ierr = MatCreate(PETSC_COMM_SELF,&ScalingMat);
ierr = MatSetSizes(ScalingMat,n_local_lambda,n_local_lambda,n_local_lambda,n_local_lambda);CHKERRQ(ierr);
ierr = MatSetType(ScalingMat,MATSEQAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(ScalingMat,1,NULL);CHKERRQ(ierr);
for (i=0;i<n_local_lambda;i++) {
ierr = MatSetValue(ScalingMat,i,i,scaling_factors[i],INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(ScalingMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (ScalingMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatMatMult(ScalingMat,fetidpmat_ctx->B_delta,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&fetidpmat_ctx->B_Ddelta);CHKERRQ(ierr);
ierr = MatDestroy(&ScalingMat);CHKERRQ(ierr);
} else {
ierr = MatCreate(PETSC_COMM_SELF,&fetidpmat_ctx->B_Ddelta);
ierr = MatSetSizes(fetidpmat_ctx->B_Ddelta,n_local_lambda,pcis->n_B,n_local_lambda,pcis->n_B);CHKERRQ(ierr);
ierr = MatSetType(fetidpmat_ctx->B_Ddelta,MATSEQAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(fetidpmat_ctx->B_Ddelta,1,NULL);CHKERRQ(ierr);
for (i=0;i<n_local_lambda;i++) {
ierr = MatSetValue(fetidpmat_ctx->B_Ddelta,i,cols_B_delta[i],scaling_factors[i],INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(fetidpmat_ctx->B_Ddelta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (fetidpmat_ctx->B_Ddelta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
ierr = PetscFree(scaling_factors);CHKERRQ(ierr);
ierr = PetscFree(cols_B_delta);CHKERRQ(ierr);
/* Create some vectors needed by fetidp */
ierr = VecDuplicate(pcis->vec1_B,&fetidpmat_ctx->temp_solution_B);CHKERRQ(ierr);
ierr = VecDuplicate(pcis->vec1_D,&fetidpmat_ctx->temp_solution_D);CHKERRQ(ierr);
test_fetidp = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-fetidp_check",&test_fetidp,NULL);CHKERRQ(ierr);
if (test_fetidp && !pcbddc->use_deluxe_scaling) {
PetscReal real_value;
ierr = PetscViewerASCIIGetStdout(comm,&viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"----------FETI_DP TESTS--------------\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"All tests should return zero!\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"FETIDP MAT context in the ");CHKERRQ(ierr);
if (fully_redundant) {
ierr = PetscViewerASCIIPrintf(viewer,"fully redundant case for lagrange multipliers.\n");CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer,"Non-fully redundant case for lagrange multiplier.\n");CHKERRQ(ierr);
}
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
/******************************************************************/
/* TEST A/B: Test numbering of global lambda dofs */
/******************************************************************/
ierr = VecDuplicate(fetidpmat_ctx->lambda_local,&test_vec);CHKERRQ(ierr);
ierr = VecSet(lambda_global,1.0);CHKERRQ(ierr);
ierr = VecSet(test_vec,1.0);CHKERRQ(ierr);
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
scalar_value = -1.0;
ierr = VecAXPY(test_vec,scalar_value,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
ierr = VecNorm(test_vec,NORM_INFINITY,&real_value);CHKERRQ(ierr);
ierr = VecDestroy(&test_vec);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(viewer,"A[%04d]: CHECK glob to loc: % 1.14e\n",rank,real_value);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
if (fully_redundant) {
ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr);
ierr = VecSet(fetidpmat_ctx->lambda_local,0.5);CHKERRQ(ierr);
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecSum(lambda_global,&scalar_value);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(viewer,"B[%04d]: CHECK loc to glob: % 1.14e\n",rank,PetscRealPart(scalar_value)-fetidpmat_ctx->n_lambda);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
}
/******************************************************************/
/* TEST C: It should holds B_delta*w=0, w\in\widehat{W} */
/* This is the meaning of the B matrix */
/******************************************************************/
ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Action of B_delta */
ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecNorm(lambda_global,NORM_INFINITY,&real_value);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"C[coll]: CHECK infty norm of B_delta*w (w continuous): % 1.14e\n",real_value);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
/******************************************************************/
/* TEST D: It should holds E_Dw = w - P_Dw w\in\widetilde{W} */
/* E_D = R_D^TR */
/* P_D = B_{D,delta}^T B_{delta} */
/* eq.44 Mandel Tezaur and Dohrmann 2005 */
/******************************************************************/
/* compute a random vector in \widetilde{W} */
ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
scalar_value = 0.0; /* set zero at vertices */
ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
for (i=0;i<n_vertices;i++) { array[vertex_indices[i]]=scalar_value; }
ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
/* store w for final comparison */
ierr = VecDuplicate(pcis->vec1_B,&test_vec);CHKERRQ(ierr);
ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,test_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,test_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Jump operator P_D : results stored in pcis->vec1_B */
ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Action of B_delta */
ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Action of B_Ddelta^T */
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = MatMultTranspose(fetidpmat_ctx->B_Ddelta,fetidpmat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr);
/* Average operator E_D : results stored in pcis->vec2_B */
ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = PCBDDCScalingExtension(fetidpmat_ctx->pc,pcis->vec2_B,pcis->vec1_global);CHKERRQ(ierr);
ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_global,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->global_to_B,pcis->vec1_global,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* test E_D=I-P_D */
scalar_value = 1.0;
ierr = VecAXPY(pcis->vec1_B,scalar_value,pcis->vec2_B);CHKERRQ(ierr);
scalar_value = -1.0;
ierr = VecAXPY(pcis->vec1_B,scalar_value,test_vec);CHKERRQ(ierr);
ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&real_value);CHKERRQ(ierr);
ierr = VecDestroy(&test_vec);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(viewer,"D[%04d] CHECK infty norm of E_D + P_D - I: % 1.14e\n",rank,real_value);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
/******************************************************************/
/* TEST E: It should holds R_D^TP_Dw=0 w\in\widetilde{W} */
/* eq.48 Mandel Tezaur and Dohrmann 2005 */
/******************************************************************/
ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
scalar_value = 0.0; /* set zero at vertices */
for (i=0;i<n_vertices;i++) { array[vertex_indices[i]]=scalar_value; }
ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
/* Jump operator P_D : results stored in pcis->vec1_B */
ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Action of B_delta */
ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Action of B_Ddelta^T */
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = MatMultTranspose(fetidpmat_ctx->B_Ddelta,fetidpmat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr);
/* scaling */
ierr = PCBDDCScalingExtension(fetidpmat_ctx->pc,pcis->vec1_B,pcis->vec1_global);CHKERRQ(ierr);
ierr = VecNorm(pcis->vec1_global,NORM_INFINITY,&real_value);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"E[coll]: CHECK infty norm of R^T_D P_D: % 1.14e\n",real_value);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
if (!fully_redundant) {
/******************************************************************/
/* TEST F: It should holds B_{delta}B^T_{D,delta}=I */
/* Corollary thm 14 Mandel Tezaur and Dohrmann 2005 */
/******************************************************************/
ierr = VecDuplicate(lambda_global,&test_vec);CHKERRQ(ierr);
ierr = VecSetRandom(lambda_global,NULL);CHKERRQ(ierr);
/* Action of B_Ddelta^T */
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = MatMultTranspose(fetidpmat_ctx->B_Ddelta,fetidpmat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr);
/* Action of B_delta */
ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
ierr = VecSet(test_vec,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,test_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,test_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
scalar_value = -1.0;
ierr = VecAXPY(lambda_global,scalar_value,test_vec);CHKERRQ(ierr);
ierr = VecNorm(lambda_global,NORM_INFINITY,&real_value);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"E[coll]: CHECK infty norm of P^T_D - I: % 1.14e\n",real_value);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
ierr = VecDestroy(&test_vec);CHKERRQ(ierr);
}
}
/* final cleanup */
ierr = PetscFree(vertex_indices);CHKERRQ(ierr);
ierr = VecDestroy(&lambda_global);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
const struct {PetscInt i,j; PetscScalar v;} entries[] = {{0,3,1.},{1,2,2.},{2,1,3.},{2,4,4.},{3,0,5.},{3,3,6.},{4,1,7.},{4,4,8.}};
const PetscInt ixrow[5] = {4,2,1,3,0},ixcol[5] = {3,2,1,4,0};
Mat A,B;
PetscErrorCode ierr;
PetscInt i,rstart,rend,cstart,cend;
IS isrow,iscol;
PetscViewer viewer,sviewer;
PetscBool view_sparse;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
/* ------- Assemble matrix, --------- */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,5,5);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&rstart,&rend);CHKERRQ(ierr);
ierr = MatGetOwnershipRangeColumn(A,&cstart,&cend);CHKERRQ(ierr);
for (i=0; i<(PetscInt)(sizeof(entries)/sizeof(entries[0])); i++) {
ierr = MatSetValue(A,entries[i].i,entries[i].j,entries[i].v,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* ------ Prepare index sets ------ */
ierr = ISCreateGeneral(PETSC_COMM_WORLD,rend-rstart,ixrow+rstart,PETSC_USE_POINTER,&isrow);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,5,ixcol,PETSC_USE_POINTER,&iscol);CHKERRQ(ierr);
ierr = ISSetPermutation(isrow);CHKERRQ(ierr);
ierr = ISSetPermutation(iscol);CHKERRQ(ierr);
ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
view_sparse = PETSC_FALSE;
ierr = PetscOptionsGetBool(PETSC_NULL, "-view_sparse", &view_sparse, PETSC_NULL);CHKERRQ(ierr);
if (!view_sparse) {
ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_DENSE);CHKERRQ(ierr);
}
ierr = PetscViewerASCIIPrintf(viewer,"Original matrix\n");CHKERRQ(ierr);
ierr = MatView(A,viewer);CHKERRQ(ierr);
ierr = MatPermute(A,isrow,iscol,&B);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"Permuted matrix\n");CHKERRQ(ierr);
ierr = MatView(B,viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"Row permutation\n");CHKERRQ(ierr);
ierr = ISView(isrow,viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"Column permutation\n");CHKERRQ(ierr);
ierr = PetscViewerGetSingleton(viewer,&sviewer);CHKERRQ(ierr);
ierr = ISView(iscol,sviewer);CHKERRQ(ierr);
ierr = PetscViewerRestoreSingleton(viewer,&sviewer);CHKERRQ(ierr);
/* Free data structures */
ierr = ISDestroy(&isrow);CHKERRQ(ierr);
ierr = ISDestroy(&iscol);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
PetscErrorCode ModifyMatDiagonals( Mat M, Mat A, Mat D, Vec epsSReal, Vec epspmlQ, Vec epsmedium, Vec epsC, Vec epsCi, Vec epsP, int Nxyz, double omega, Vec epsilon)
{
PetscErrorCode ierr;
/*-------Compute the epsdiff -----------------------------*/
//compute current epsilon epsC;
ierr =MatMult(A, epsSReal,epsC);
CHKERRQ(ierr);
VecCopy(epsC,epsFReal);
ierr = VecPointwiseMult(epsC,epsC,epsilon);
ierr = VecAXPY(epsC,1.0,epsmedium);
CHKERRQ(ierr);
ierr = VecPointwiseMult(epsC,epsC,epspmlQ);
CHKERRQ(ierr);
//store the difference = current-previous into current epsilon;
ierr =VecAXPY(epsC,-1.0,epsP);
CHKERRQ(ierr); // epsC is the epsDiff now;
//compute epsCi = i*epsC;
ierr =MatMult(D,epsC,epsCi);
CHKERRQ(ierr); // make all the needed local;
/*---------Modify diagonals of M (more than main diagonals)------*/
int ns, ne;
ierr = MatGetOwnershipRange(M, &ns, &ne);
CHKERRQ(ierr);
double *c, *ci;
ierr = VecGetArray(epsC, &c);
CHKERRQ(ierr);
ierr = VecGetArray(epsCi, &ci);
CHKERRQ(ierr);
int i;
double omegasqr=pow(omega,2.0);
double vr, vi;
for (i = ns; i < ne; ++i)
{
if(i<3*Nxyz)
{ vr = c[i-ns];
vi = -ci[i-ns];
}
else
{ vr = ci[i-ns];
vi = c[i-ns];
}
//M = M - omega^2*eps
ierr = MatSetValue(M,i,i,-omegasqr*vr,ADD_VALUES);
CHKERRQ(ierr);
ierr = MatSetValue(M,i,(i+3*Nxyz)%(6*Nxyz), pow(-1,i/(3*Nxyz))*omegasqr*vi,ADD_VALUES);
CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(M, MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = MatAssemblyEnd(M, MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = VecRestoreArray(epsC, &c);
CHKERRQ(ierr);
ierr = VecRestoreArray(epsCi, &ci);
CHKERRQ(ierr);
/*-----------update epsP to store current epsilons-------------*/
ierr= VecAXPY(epsP,1.0,epsC);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode myinterp(MPI_Comm comm, Mat *Aout, int Nx, int Ny, int Nz, int Nxo, int Nyo, int Nzo, int Mx, int My, int Mz, int Mzslab, int anisotropic)
{
Mat A;
int nz = 1; /* max # nonzero elements in each row */
PetscErrorCode ierr;
int ns, ne;
double shift = 0.5;
int i;
int Nc = 3; //modified;
int Mxyz = Mx*My*((Mzslab==0)?Mz:1);
int DegFree= (anisotropic ? 3 : 1)* Mxyz;
//ierr = MatCreateAIJ(comm, PETSC_DECIDE, PETSC_DECIDE, Nx*Ny*Nz*6, Mxyz, nz, NULL, nz, NULL, &A); CHKERRQ(ierr);
MatCreate(comm, &A);
MatSetType(A,MATMPIAIJ);
MatSetSizes(A,PETSC_DECIDE, PETSC_DECIDE, 6*Nx*Ny*Nz, DegFree);
MatMPIAIJSetPreallocation(A, nz, PETSC_NULL, nz, PETSC_NULL);
ierr = MatGetOwnershipRange(A, &ns, &ne);
CHKERRQ(ierr);
for (i = ns; i < ne; ++i) {
int ix, iy, iz, ic;
double xd,yd,zd; /* (ix,iy,iz) location in d coordinates */
int ixd,iyd,izd; /* rounded (xd,yd,zd) */
int j, id;
iz = (j = i) % Nz;
iy = (j /= Nz) % Ny;
ix = (j /= Ny) % Nx;
ic = (j /= Nx) % Nc; // modifed, Nc = 3;
xd = (ix-Nxo) + (ic!= 0)*shift;
ixd = ceil(xd-0.5);
if (ixd < 0 || ixd >= Mx) continue;
yd = (iy-Nyo) + (ic!= 1)*shift;
iyd = ceil(yd - 0.5);
if (iyd < 0 || iyd >= My) continue;
zd = (iz-Nzo) + (ic!= 2)*shift;
izd = ceil(zd - 0.5);
if (izd < 0 || izd >= Mz) continue;
if(Mzslab!=0)
id = (ixd*My + iyd);
else
id = (ixd*My + iyd)*Mz + izd;
ierr = MatSetValue(A, i, id + (anisotropic!=0)*ic*Mxyz, 1.0, INSERT_VALUES);
CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) A,
"InterpMatrix");
CHKERRQ(ierr);
*Aout = A;
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Vec x,b,u;
Mat A; /* linear system matrix */
KSP ksp; /* linear solver context */
PetscRandom rctx; /* random number generator context */
PetscReal norm; /* norm of solution error */
PetscInt i,j,k,l,n = 27,its,bs = 2,Ii,J;
PetscErrorCode ierr;
PetscScalar v;
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
ierr = PetscOptionsGetInt(NULL,NULL,"-bs",&bs,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,n*bs,n*bs,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetBlockSize(A,bs);CHKERRQ(ierr);
ierr = MatSetType(A,MATSEQBAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
/*
Don't bother to preallocate matrix
*/
ierr = PetscRandomCreate(PETSC_COMM_SELF,&rctx);CHKERRQ(ierr);
for (i=0; i<n; i++) {
for (j=0; j<n; j++) {
ierr = PetscRandomGetValue(rctx,&v);CHKERRQ(ierr);
if (PetscRealPart(v) < .25 || i == j) {
for (k=0; k<bs; k++) {
for (l=0; l<bs; l++) {
ierr = PetscRandomGetValue(rctx,&v);CHKERRQ(ierr);
Ii = i*bs + k;
J = j*bs + l;
if (Ii == J) v += 10.;
ierr = MatSetValue(A,Ii,J,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
}
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr);
ierr = VecSetSizes(u,PETSC_DECIDE,n*bs);CHKERRQ(ierr);
ierr = VecSetFromOptions(u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b);CHKERRQ(ierr);
ierr = VecDuplicate(b,&x);CHKERRQ(ierr);
ierr = VecSet(u,1.0);CHKERRQ(ierr);
ierr = MatMult(A,u,b);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the linear solver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
*/
ierr = KSPSetOperators(ksp,A,A);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Check the error
*/
ierr = VecAXPY(x,-1.0,u);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
/*
Print convergence information. PetscPrintf() produces a single
print statement from all processes that share a communicator.
An alternative is PetscFPrintf(), which prints to a file.
*/
if (norm > .1) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of residual %g iterations %D bs %D\n",(double)norm,its,bs);CHKERRQ(ierr);
}
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);
/*
Always call PetscFinalize() before exiting a program. This routine
- finalizes the PETSc libraries as well as MPI
- provides summary and diagnostic information if certain runtime
options are chosen (e.g., -log_summary).
*/
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **argv)
{
Mat M,C,K; /* problem matrices */ /* polynomial eigenproblem solver context */
PetscInt n=10,Istart,Iend,i;
PetscScalar z=1.0;
char str[50],file[PETSC_MAX_PATH_LEN];
PetscErrorCode ierr;
PetscViewer view;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetScalar(NULL,"-z",&z,NULL);CHKERRQ(ierr);
ierr = SlepcSNPrintfScalar(str,50,z,PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nAcoustic wave 1-D, n=%D z=%s\n\n",n,str);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrices that define the eigensystem, (k^2*M+k*C+K)x=0
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* K is a tridiagonal */
ierr = MatCreate(PETSC_COMM_WORLD,&K);CHKERRQ(ierr);
ierr = MatSetSizes(K,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(K);CHKERRQ(ierr);
ierr = MatSetUp(K);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(K,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
if (i>0) {
ierr = MatSetValue(K,i,i-1,-1.0*n,INSERT_VALUES);CHKERRQ(ierr);
}
if (i<n-1) {
ierr = MatSetValue(K,i,i,2.0*n,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(K,i,i+1,-1.0*n,INSERT_VALUES);CHKERRQ(ierr);
} else {
ierr = MatSetValue(K,i,i,1.0*n,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(K,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(K,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* C is the zero matrix but one element*/
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C,&Istart,&Iend);CHKERRQ(ierr);
if (n-1>=Istart && n-1<Iend) {
ierr = MatSetValue(C,n-1,n-1,-2*PETSC_PI/z,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* M is a diagonal matrix */
ierr = MatCreate(PETSC_COMM_WORLD,&M);CHKERRQ(ierr);
ierr = MatSetSizes(M,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(M);CHKERRQ(ierr);
ierr = MatSetUp(M);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(M,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
if (i<n-1) {
ierr = MatSetValue(M,i,i,4*PETSC_PI*PETSC_PI/n,INSERT_VALUES);CHKERRQ(ierr);
} else {
ierr = MatSetValue(M,i,i,2*PETSC_PI*PETSC_PI/n,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
sprintf(file, "acoustic_wave_1d_m_n%d_z%.1f.petsc", n,z);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file,FILE_MODE_WRITE,&view);CHKERRQ(ierr);
ierr = MatView(M,view);CHKERRQ(ierr);
ierr = MatDestroy(&M);CHKERRQ(ierr);
sprintf(file, "acoustic_wave_1d_c_n%d_z%.1f.petsc", n,z);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file,FILE_MODE_WRITE,&view);CHKERRQ(ierr);
ierr = MatView(C,view);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
sprintf(file, "acoustic_wave_1d_k_n%d_z%.1f.petsc", n,z);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file,FILE_MODE_WRITE,&view);CHKERRQ(ierr);
ierr = MatView(K,view);CHKERRQ(ierr);
ierr = MatDestroy(&K);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **argv)
{
Mat A,B,M,mat[2];
ST st;
Vec v,w;
STType type;
PetscScalar value[3],sigma,tau;
PetscInt n=10,i,Istart,Iend,col[3];
PetscBool FirstBlock=PETSC_FALSE,LastBlock=PETSC_FALSE;
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n1-D Laplacian plus diagonal, n=%D\n\n",n);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the operator matrix for the 1-D Laplacian
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&B);CHKERRQ(ierr);
ierr = MatSetSizes(B,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(B);CHKERRQ(ierr);
ierr = MatSetUp(B);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
if (Istart==0) FirstBlock=PETSC_TRUE;
if (Iend==n) LastBlock=PETSC_TRUE;
value[0]=-1.0; value[1]=2.0; value[2]=-1.0;
for (i=(FirstBlock? Istart+1: Istart); i<(LastBlock? Iend-1: Iend); i++) {
col[0]=i-1; col[1]=i; col[2]=i+1;
ierr = MatSetValues(A,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(B,i,i,(PetscScalar)i,INSERT_VALUES);CHKERRQ(ierr);
}
if (LastBlock) {
i=n-1; col[0]=n-2; col[1]=n-1;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(B,i,i,(PetscScalar)i,INSERT_VALUES);CHKERRQ(ierr);
}
if (FirstBlock) {
i=0; col[0]=0; col[1]=1; value[0]=2.0; value[1]=-1.0;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(B,i,i,-1.0,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatGetVecs(A,&v,&w);CHKERRQ(ierr);
ierr = VecSet(v,1.0);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the spectral transformation object
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = STCreate(PETSC_COMM_WORLD,&st);CHKERRQ(ierr);
mat[0] = A;
mat[1] = B;
ierr = STSetOperators(st,2,mat);CHKERRQ(ierr);
ierr = STSetFromOptions(st);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Apply the transformed operator for several ST's
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* shift, sigma=0.0 */
ierr = STSetUp(st);CHKERRQ(ierr);
ierr = STGetType(st,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"ST type %s\n",type);CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* shift, sigma=0.1 */
sigma = 0.1;
ierr = STSetShift(st,sigma);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g\n",(double)PetscRealPart(sigma));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* sinvert, sigma=0.1 */
ierr = STPostSolve(st);CHKERRQ(ierr); /* undo changes if inplace */
ierr = STSetType(st,STSINVERT);CHKERRQ(ierr);
ierr = STGetType(st,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"ST type %s\n",type);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g\n",(double)PetscRealPart(sigma));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* sinvert, sigma=-0.5 */
sigma = -0.5;
ierr = STSetShift(st,sigma);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g\n",(double)PetscRealPart(sigma));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* cayley, sigma=-0.5, tau=-0.5 (equal to sigma by default) */
ierr = STPostSolve(st);CHKERRQ(ierr); /* undo changes if inplace */
ierr = STSetType(st,STCAYLEY);CHKERRQ(ierr);
ierr = STSetUp(st);CHKERRQ(ierr);
ierr = STGetType(st,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"ST type %s\n",type);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = STCayleyGetAntishift(st,&tau);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g, antishift=%g\n",(double)PetscRealPart(sigma),(double)PetscRealPart(tau));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* cayley, sigma=1.1, tau=1.1 (still equal to sigma) */
sigma = 1.1;
ierr = STSetShift(st,sigma);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = STCayleyGetAntishift(st,&tau);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g, antishift=%g\n",(double)PetscRealPart(sigma),(double)PetscRealPart(tau));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* cayley, sigma=1.1, tau=-1.0 */
tau = -1.0;
ierr = STCayleySetAntishift(st,tau);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = STCayleyGetAntishift(st,&tau);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g, antishift=%g\n",(double)PetscRealPart(sigma),(double)PetscRealPart(tau));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check inner product matrix in Cayley
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = STGetBilinearForm(st,&M);CHKERRQ(ierr);
ierr = MatMult(M,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
ierr = STDestroy(&st);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = VecDestroy(&v);CHKERRQ(ierr);
ierr = VecDestroy(&w);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
PetscErrorCode BSSEER2Mat(BSS self, int q, Mat M) {
int k = self->order;
int nb = self->num_basis;
int nq = self->order * self->num_ele;
PetscErrorCode ierr;
ierr = BSSCheck(self); CHKERRQ(ierr);
InsertMode mode = INSERT_VALUES;
PetscScalar *sg_ij;
ierr = PetscMalloc1(nq*nq, &sg_ij); CHKERRQ(ierr);
for(int i = 0; i < nq; i++)
for(int j = 0; j < nq; j++) {
PetscScalar g = self->xs[i]>self->xs[j] ? self->Rrs[i] : self->Rrs[j];
PetscScalar s = self->xs[i]>self->xs[j] ? self->Rrs[j] : self->Rrs[i];
sg_ij[j+nq*i] = pow(s/g, q)/g;
}
PetscScalar *wvv; ierr = PetscMalloc1(nb*nb*nq, &wvv); CHKERRQ(ierr);
int *i0s; ierr = PetscMalloc1(nb*nb, &i0s); CHKERRQ(ierr);
int *i1s; ierr = PetscMalloc1(nb*nb, &i1s); CHKERRQ(ierr);
for(int a = 0; a < nb; a++){
int c0 = a-k+1; c0 = c0<0?0:c0;
int c1 = a+k ; c1 = c1>nb?nb:c1;
for(int c = c0; c < c1; c++) {
int i0, i1; Non0QuadIndex(a, c, k, nq, &i0, &i1);
i0s[a*nb+c] = i0; i1s[a*nb+c] = i1;
for(int n = 0; n < nq; n++)
wvv[a*nb*nq+c*nq+n]= self->ws[n] * self->vals[a*nq+n] * self->vals[c*nq+n];
}
}
for(int a = 0; a < nb; a++) {
int c0 = a-k+1; c0 = c0<0?0:c0;
for(int c = c0; c <= a; c++) {
for(int b = 0; b < nb; b++) {
int d0 = b-k+1; d0 = d0<0?0:d0;
for(int d = d0; d <= b; d++) {
PetscScalar v = 0.0;
for(int i = i0s[a*nb+c]; i < i1s[a*nb+c]; i++) {
PetscScalar aci = wvv[a*nb*nq + c*nq + i];
for(int j = i0s[b*nb+d]; j < i1s[b*nb+d]; j++)
v += aci * sg_ij[i*nq+j] * wvv[b*nb*nq + d*nq + j];
}
if(a > c && b > d) {
ierr = MatSetValue(M, a*nb+b, c*nb+d, v, mode); CHKERRQ(ierr);
ierr = MatSetValue(M, a*nb+d, c*nb+b, v, mode); CHKERRQ(ierr);
ierr = MatSetValue(M, c*nb+b, a*nb+d, v, mode); CHKERRQ(ierr);
ierr = MatSetValue(M, c*nb+d, a*nb+b, v, mode); CHKERRQ(ierr);
} else if(a > c && b == d) {
ierr = MatSetValue(M, a*nb+b, c*nb+d, v, mode); CHKERRQ(ierr);
ierr = MatSetValue(M, c*nb+b, a*nb+d, v, mode); CHKERRQ(ierr);
} else if(a == c && b > d) {
ierr = MatSetValue(M, a*nb+b, c*nb+d, v, mode); CHKERRQ(ierr);
ierr = MatSetValue(M, a*nb+d, c*nb+b, v, mode); CHKERRQ(ierr);
} else if(a == c && b == d) {
ierr = MatSetValue(M, a*nb+b, c*nb+d, v, mode); CHKERRQ(ierr);
}
}
}
}
}
PetscFree(sg_ij); PetscFree(wvv); PetscFree(i0s); PetscFree(i1s);
MatAssemblyBegin(M, MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(M, MAT_FINAL_ASSEMBLY);
return 0;
}
int main(int argc,char **argv)
{
Mat A; /* operator matrix */
Vec u,v; /* left and right singular vectors */
SVD svd; /* singular value problem solver context */
SVDType type;
PetscReal error,tol,sigma,mu=PETSC_SQRT_MACHINE_EPSILON;
PetscInt n=100,i,j,Istart,Iend,nsv,maxit,its,nconv;
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-mu",&mu,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nLauchli singular value decomposition, (%D x %D) mu=%g\n\n",n+1,n,(double)mu);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Build the Lauchli matrix
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n+1,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
if (i == 0) {
for (j=0;j<n;j++) {
ierr = MatSetValue(A,0,j,1.0,INSERT_VALUES);CHKERRQ(ierr);
}
} else {
ierr = MatSetValue(A,i,i-1,mu,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatGetVecs(A,&v,&u);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the singular value solver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create singular value solver context
*/
ierr = SVDCreate(PETSC_COMM_WORLD,&svd);CHKERRQ(ierr);
/*
Set operator
*/
ierr = SVDSetOperator(svd,A);CHKERRQ(ierr);
/*
Use thick-restart Lanczos as default solver
*/
ierr = SVDSetType(svd,SVDTRLANCZOS);CHKERRQ(ierr);
/*
Set solver parameters at runtime
*/
ierr = SVDSetFromOptions(svd);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the singular value system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = SVDSolve(svd);CHKERRQ(ierr);
ierr = SVDGetIterationNumber(svd,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %D\n",its);CHKERRQ(ierr);
/*
Optional: Get some information from the solver and display it
*/
ierr = SVDGetType(svd,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Solution method: %s\n\n",type);CHKERRQ(ierr);
ierr = SVDGetDimensions(svd,&nsv,NULL,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of requested singular values: %D\n",nsv);CHKERRQ(ierr);
ierr = SVDGetTolerances(svd,&tol,&maxit);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Stopping condition: tol=%.4g, maxit=%D\n",(double)tol,maxit);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Get number of converged singular triplets
*/
ierr = SVDGetConverged(svd,&nconv);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of converged approximate singular triplets: %D\n\n",nconv);CHKERRQ(ierr);
if (nconv>0) {
/*
Display singular values and relative errors
*/
ierr = PetscPrintf(PETSC_COMM_WORLD,
" sigma relative error\n"
" --------------------- ------------------\n");CHKERRQ(ierr);
for (i=0;i<nconv;i++) {
/*
Get converged singular triplets: i-th singular value is stored in sigma
*/
ierr = SVDGetSingularTriplet(svd,i,&sigma,u,v);CHKERRQ(ierr);
/*
Compute the error associated to each singular triplet
*/
ierr = SVDComputeRelativeError(svd,i,&error);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," % 6f ",(double)sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," % 12g\n",(double)error);CHKERRQ(ierr);
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n");CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = SVDDestroy(&svd);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&v);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
int main(int argc,char **argv)
{
Mat M,Mo,C,K,Ko,A[3]; /* problem matrices */
PEP pep; /* polynomial eigenproblem solver context */
IS isf,isbc,is;
PetscInt n=200,nele,Istart,Iend,i,j,mloc,nloc,bc[2];
PetscReal width=0.05,height=0.005,glength=1.0,dlen,EI,area,rho;
PetscScalar K1[4],K2[4],K2t[4],K3[4],M1[4],M2[4],M2t[4],M3[4],damp=5.0;
PetscBool terse;
PetscErrorCode ierr;
PetscLogDouble time1,time2;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
nele = n/2;
n = 2*nele;
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nSimply supported beam damped in the middle, n=%D (nele=%D)\n\n",n,nele);CHKERRQ(ierr);
dlen = glength/nele;
EI = 7e10*width*height*height*height/12.0;
area = width*height;
rho = 0.674/(area*glength);
K1[0] = 12; K1[1] = 6*dlen; K1[2] = 6*dlen; K1[3] = 4*dlen*dlen;
K2[0] = -12; K2[1] = 6*dlen; K2[2] = -6*dlen; K2[3] = 2*dlen*dlen;
K2t[0] = -12; K2t[1] = -6*dlen; K2t[2] = 6*dlen; K2t[3] = 2*dlen*dlen;
K3[0] = 12; K3[1] = -6*dlen; K3[2] = -6*dlen; K3[3] = 4*dlen*dlen;
M1[0] = 156; M1[1] = 22*dlen; M1[2] = 22*dlen; M1[3] = 4*dlen*dlen;
M2[0] = 54; M2[1] = -13*dlen; M2[2] = 13*dlen; M2[3] = -3*dlen*dlen;
M2t[0] = 54; M2t[1] = 13*dlen; M2t[2] = -13*dlen; M2t[3] = -3*dlen*dlen;
M3[0] = 156; M3[1] = -22*dlen; M3[2] = -22*dlen; M3[3] = 4*dlen*dlen;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrices that define the eigensystem, (k^2*M+k*C+K)x=0
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* K is block-tridiagonal */
ierr = MatCreate(PETSC_COMM_WORLD,&Ko);CHKERRQ(ierr);
ierr = MatSetSizes(Ko,PETSC_DECIDE,PETSC_DECIDE,n+2,n+2);CHKERRQ(ierr);
ierr = MatSetBlockSize(Ko,2);CHKERRQ(ierr);
ierr = MatSetFromOptions(Ko);CHKERRQ(ierr);
ierr = MatSetUp(Ko);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(Ko,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart/2;i<Iend/2;i++) {
if (i>0) {
j = i-1;
ierr = MatSetValuesBlocked(Ko,1,&i,1,&j,K2t,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValuesBlocked(Ko,1,&i,1,&i,K3,ADD_VALUES);CHKERRQ(ierr);
}
if (i<nele) {
j = i+1;
ierr = MatSetValuesBlocked(Ko,1,&i,1,&j,K2,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValuesBlocked(Ko,1,&i,1,&i,K1,ADD_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(Ko,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(Ko,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatScale(Ko,EI/(dlen*dlen*dlen));CHKERRQ(ierr);
/* M is block-tridiagonal */
ierr = MatCreate(PETSC_COMM_WORLD,&Mo);CHKERRQ(ierr);
ierr = MatSetSizes(Mo,PETSC_DECIDE,PETSC_DECIDE,n+2,n+2);CHKERRQ(ierr);
ierr = MatSetBlockSize(Mo,2);CHKERRQ(ierr);
ierr = MatSetFromOptions(Mo);CHKERRQ(ierr);
ierr = MatSetUp(Mo);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(Mo,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart/2;i<Iend/2;i++) {
if (i>0) {
j = i-1;
ierr = MatSetValuesBlocked(Mo,1,&i,1,&j,M2t,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValuesBlocked(Mo,1,&i,1,&i,M3,ADD_VALUES);CHKERRQ(ierr);
}
if (i<nele) {
j = i+1;
ierr = MatSetValuesBlocked(Mo,1,&i,1,&j,M2,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValuesBlocked(Mo,1,&i,1,&i,M1,ADD_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(Mo,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(Mo,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatScale(Mo,rho*area*dlen/420);CHKERRQ(ierr);
/* remove rows/columns from K and M corresponding to boundary conditions */
ierr = ISCreateStride(PETSC_COMM_WORLD,Iend-Istart,Istart,1,&isf);CHKERRQ(ierr);
bc[0] = 0; bc[1] = n;
ierr = ISCreateGeneral(PETSC_COMM_SELF,2,bc,PETSC_USE_POINTER,&isbc);CHKERRQ(ierr);
ierr = ISDifference(isf,isbc,&is);CHKERRQ(ierr);
ierr = MatGetSubMatrix(Ko,is,is,MAT_INITIAL_MATRIX,&K);CHKERRQ(ierr);
ierr = MatGetSubMatrix(Mo,is,is,MAT_INITIAL_MATRIX,&M);CHKERRQ(ierr);
ierr = MatGetLocalSize(M,&mloc,&nloc);CHKERRQ(ierr);
/* C is zero except for the (nele,nele)-entry */
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,mloc,nloc,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C,&Istart,&Iend);CHKERRQ(ierr);
if (nele-1>=Istart && nele-1<Iend) {
ierr = MatSetValue(C,nele-1,nele-1,damp,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and solve the problem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PEPCreate(PETSC_COMM_WORLD,&pep);CHKERRQ(ierr);
A[0] = K; A[1] = C; A[2] = M;
ierr = PEPSetOperators(pep,3,A);CHKERRQ(ierr);
ierr = PEPSetFromOptions(pep);CHKERRQ(ierr);
ierr = PetscTime(&time1); CHKERRQ(ierr);
ierr = PEPSolve(pep);CHKERRQ(ierr);
ierr = PetscTime(&time2); CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* show detailed info unless -terse option is given by user */
ierr = PetscOptionsHasName(NULL,"-terse",&terse);CHKERRQ(ierr);
if (terse) {
ierr = PEPErrorView(pep,PEP_ERROR_BACKWARD,NULL);CHKERRQ(ierr);
} else {
ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO_DETAIL);CHKERRQ(ierr);
ierr = PEPReasonView(pep,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PEPErrorView(pep,PEP_ERROR_BACKWARD,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"Time: %g\n\n\n",time2-time1);CHKERRQ(ierr);
ierr = PEPDestroy(&pep);CHKERRQ(ierr);
ierr = ISDestroy(&isf);CHKERRQ(ierr);
ierr = ISDestroy(&isbc);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&K);CHKERRQ(ierr);
ierr = MatDestroy(&Ko);CHKERRQ(ierr);
ierr = MatDestroy(&Mo);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **argv)
{
Mat M,C,K,A[3]; /* problem matrices */
PEP pep; /* polynomial eigenproblem solver context */
PetscInt n=10,Istart,Iend,i;
PetscScalar z=1.0;
char str[50];
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetScalar(NULL,"-z",&z,NULL);CHKERRQ(ierr);
ierr = SlepcSNPrintfScalar(str,50,z,PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nAcoustic wave 1-D, n=%D z=%s\n\n",n,str);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrices that define the eigensystem, (k^2*M+k*C+K)x=0
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* K is a tridiagonal */
ierr = MatCreate(PETSC_COMM_WORLD,&K);CHKERRQ(ierr);
ierr = MatSetSizes(K,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(K);CHKERRQ(ierr);
ierr = MatSetUp(K);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(K,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
if (i>0) {
ierr = MatSetValue(K,i,i-1,-1.0*n,INSERT_VALUES);CHKERRQ(ierr);
}
if (i<n-1) {
ierr = MatSetValue(K,i,i,2.0*n,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(K,i,i+1,-1.0*n,INSERT_VALUES);CHKERRQ(ierr);
} else {
ierr = MatSetValue(K,i,i,1.0*n,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(K,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(K,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* C is the zero matrix but one element*/
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C,&Istart,&Iend);CHKERRQ(ierr);
if (n-1>=Istart && n-1<Iend) {
ierr = MatSetValue(C,n-1,n-1,-2*PETSC_PI/z,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* M is a diagonal matrix */
ierr = MatCreate(PETSC_COMM_WORLD,&M);CHKERRQ(ierr);
ierr = MatSetSizes(M,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(M);CHKERRQ(ierr);
ierr = MatSetUp(M);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(M,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
if (i<n-1) {
ierr = MatSetValue(M,i,i,4*PETSC_PI*PETSC_PI/n,INSERT_VALUES);CHKERRQ(ierr);
} else {
ierr = MatSetValue(M,i,i,2*PETSC_PI*PETSC_PI/n,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and solve the problem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PEPCreate(PETSC_COMM_WORLD,&pep);CHKERRQ(ierr);
A[0] = K; A[1] = C; A[2] = M;
ierr = PEPSetOperators(pep,3,A);CHKERRQ(ierr);
ierr = PEPSetFromOptions(pep);CHKERRQ(ierr);
ierr = PEPSolve(pep);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PEPPrintSolution(pep,NULL);CHKERRQ(ierr);
ierr = PEPDestroy(&pep);CHKERRQ(ierr);
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&K);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **argv)
{
Mat A,B,C,D,mat[4];
ST st;
Vec v,w;
STType type;
PetscScalar value[3],sigma;
PetscInt n=10,i,Istart,Iend,col[3];
PetscBool FirstBlock=PETSC_FALSE,LastBlock=PETSC_FALSE;
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n1-D Laplacian plus diagonal, n=%D\n\n",n);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the operator matrix for the 1-D Laplacian
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&B);CHKERRQ(ierr);
ierr = MatSetSizes(B,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(B);CHKERRQ(ierr);
ierr = MatSetUp(B);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&D);CHKERRQ(ierr);
ierr = MatSetSizes(D,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(D);CHKERRQ(ierr);
ierr = MatSetUp(D);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
if (Istart==0) FirstBlock=PETSC_TRUE;
if (Iend==n) LastBlock=PETSC_TRUE;
value[0]=-1.0; value[1]=2.0; value[2]=-1.0;
for (i=(FirstBlock? Istart+1: Istart); i<(LastBlock? Iend-1: Iend); i++) {
col[0]=i-1; col[1]=i; col[2]=i+1;
ierr = MatSetValues(A,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(B,i,i,(PetscScalar)i,INSERT_VALUES);CHKERRQ(ierr);
}
if (LastBlock) {
i=n-1; col[0]=n-2; col[1]=n-1;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(B,i,i,(PetscScalar)i,INSERT_VALUES);CHKERRQ(ierr);
}
if (FirstBlock) {
i=0; col[0]=0; col[1]=1; value[0]=2.0; value[1]=-1.0;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(B,i,i,-1.0,INSERT_VALUES);CHKERRQ(ierr);
}
for (i=Istart;i<Iend;i++) {
ierr = MatSetValue(C,i,n-i-1,1.0,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(D,i,i,i*.1,INSERT_VALUES);CHKERRQ(ierr);
if (i==0) {
ierr = MatSetValue(D,0,n-1,1.0,INSERT_VALUES);CHKERRQ(ierr);
}
if (i==n-1) {
ierr = MatSetValue(D,n-1,0,1.0,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(D,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatGetVecs(A,&v,&w);CHKERRQ(ierr);
ierr = VecSet(v,1.0);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the spectral transformation object
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = STCreate(PETSC_COMM_WORLD,&st);CHKERRQ(ierr);
mat[0] = A;
mat[1] = B;
mat[2] = C;
mat[3] = D;
ierr = STSetOperators(st,4,mat);CHKERRQ(ierr);
ierr = STSetFromOptions(st);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Apply the transformed operator for several ST's
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* shift, sigma=0.0 */
ierr = STSetUp(st);CHKERRQ(ierr);
ierr = STGetType(st,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"ST type %s\n",type);CHKERRQ(ierr);
for (i=0;i<4;i++) {
ierr = STMatMult(st,i,v,w);
ierr = PetscPrintf(PETSC_COMM_WORLD,"k= %D\n",i);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
}
ierr = STMatSolve(st,v,w);
ierr = PetscPrintf(PETSC_COMM_WORLD,"solve\n");CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* shift, sigma=0.1 */
sigma = 0.1;
ierr = STSetShift(st,sigma);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g\n",(double)PetscRealPart(sigma));CHKERRQ(ierr);
for (i=0;i<4;i++) {
ierr = STMatMult(st,i,v,w);
ierr = PetscPrintf(PETSC_COMM_WORLD,"k= %D\n",i);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
}
ierr = STMatSolve(st,v,w);
ierr = PetscPrintf(PETSC_COMM_WORLD,"solve\n");CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* sinvert, sigma=0.1 */
ierr = STPostSolve(st);CHKERRQ(ierr);
ierr = STSetType(st,STSINVERT);CHKERRQ(ierr);
ierr = STGetType(st,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"ST type %s\n",type);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g\n",(double)PetscRealPart(sigma));CHKERRQ(ierr);
for (i=0;i<4;i++) {
ierr = STMatMult(st,i,v,w);
ierr = PetscPrintf(PETSC_COMM_WORLD,"k= %D\n",i);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
}
ierr = STMatSolve(st,v,w);
ierr = PetscPrintf(PETSC_COMM_WORLD,"solve\n");CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* sinvert, sigma=-0.5 */
sigma = -0.5;
ierr = STSetShift(st,sigma);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g\n",(double)PetscRealPart(sigma));CHKERRQ(ierr);
for (i=0;i<4;i++) {
ierr = STMatMult(st,i,v,w);
ierr = PetscPrintf(PETSC_COMM_WORLD,"k= %D\n",i);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
}
ierr = STMatSolve(st,v,w);
ierr = PetscPrintf(PETSC_COMM_WORLD,"solve\n");CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
ierr = STDestroy(&st);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&D);CHKERRQ(ierr);
ierr = VecDestroy(&v);CHKERRQ(ierr);
ierr = VecDestroy(&w);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
int main(int argc,char **args)
{
Vec x, b, u; /* approx solution, RHS, exact solution */
Mat A,B,C; /* linear system matrix */
KSP ksp; /* linear solver context */
PC pc; /* preconditioner context */
PetscReal norm; /* norm of solution error */
PetscErrorCode ierr;
PetscInt i,n = 20,col[3],its;
PetscMPIInt size;
PetscScalar neg_one = -1.0,one = 1.0,value[3];
PetscBool nonzeroguess = PETSC_FALSE;
PetscInitialize(&argc,&args,(char*)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size != 1) SETERRQ(PETSC_COMM_WORLD,1,"This is a uniprocessor example only!");
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,"-nonzero_guess",&nonzeroguess,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrix and right-hand-side vector that define
the linear system, Ax = b.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create vectors. Note that we form 1 vector from scratch and
then duplicate as needed.
*/
ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) x, "Solution");CHKERRQ(ierr);
ierr = VecSetSizes(x,PETSC_DECIDE,n);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&b);CHKERRQ(ierr);
ierr = VecDuplicate(x,&u);CHKERRQ(ierr);
/*
Create matrix. When using MatCreate(), the matrix format can
be specified at runtime.
Performance tuning note: For problems of substantial size,
preallocation of matrix memory is crucial for attaining good
performance. See the matrix chapter of the users manual for details.
*/
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
/*
Assemble matrix
*/
value[0] = -1.0; value[1] = 2.0; value[2] = -1.0;
for (i=1; i<n-1; i++) {
col[0] = i-1; col[1] = i; col[2] = i+1;
ierr = MatSetValues(A,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
i = n - 1; col[0] = n - 2; col[1] = n - 1;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
i = 0; col[0] = 0; col[1] = 1; value[0] = 2.0; value[1] = -1.0;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/*
jroman: added matrices
*/
ierr = MatCreate(PETSC_COMM_WORLD,&B);CHKERRQ(ierr);
ierr = MatSetSizes(B,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(B);CHKERRQ(ierr);
ierr = MatSetUp(B);CHKERRQ(ierr);
for (i=0; i<n; i++) {
ierr = MatSetValue(B,i,i,value[1],INSERT_VALUES);CHKERRQ(ierr);
if (n-i+n/3<n) {
ierr = MatSetValue(B,n-i+n/3,i,value[0],INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(B,i,n-i+n/3,value[0],INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatDuplicate(A,MAT_COPY_VALUES,&C);CHKERRQ(ierr);
ierr = MatAXPY(C,2.0,B,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
/*
Set exact solution; then compute right-hand-side vector.
*/
ierr = VecSet(u,one);CHKERRQ(ierr);
ierr = MatMult(C,u,b);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the linear solver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
*/
ierr = KSPSetOperators(ksp,C,C);CHKERRQ(ierr);
/*
Set linear solver defaults for this problem (optional).
- By extracting the KSP and PC contexts from the KSP context,
we can then directly call any KSP and PC routines to set
various options.
- The following four statements are optional; all of these
parameters could alternatively be specified at runtime via
KSPSetFromOptions();
*/
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr);
ierr = KSPSetTolerances(ksp,1.e-5,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr);
/*
Set runtime options, e.g.,
-ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
These options will override those specified above as long as
KSPSetFromOptions() is called _after_ any other customization
routines.
*/
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
if (nonzeroguess) {
PetscScalar p = .5;
ierr = VecSet(x,p);CHKERRQ(ierr);
ierr = KSPSetInitialGuessNonzero(ksp,PETSC_TRUE);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Solve linear system
*/
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Check the error
*/
ierr = VecAXPY(x,neg_one,u);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %g, Iterations %D\n",(double)norm,its);CHKERRQ(ierr);
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
/*
Always call PetscFinalize() before exiting a program. This routine
- finalizes the PETSc libraries as well as MPI
- provides summary and diagnostic information if certain runtime
options are chosen (e.g., -log_summary).
*/
ierr = PetscFinalize();
return 0;
}
void PETScLinearSolver::addMatrixEntry(const int i, const int j, const double value)
{
MatSetValue(A, i, j, value, ADD_VALUES);
}
void Geometry::MoperatorGeneralBlochFill(Mat A, int b[3][2], int DimPeriod, double k[3], int ih){
int N[3];
for(int i=0; i<3; i++) N[i] = gN.x(i);
double blochbc[3];
for(int i=0; i<3; i++) blochbc[i] = k[i]*N[i]*h[i];
int NC = 3, offset = ih*(Nxyzcr()+2);
int ns, ne;
double hh;
int bc[3][2][3]; /* bc[x/y/z direction][lo/hi][Ex/Ey/Ez] */
dcomp val, magicnum, mucp[2], mulcp[2];
dcomp cidu_phase, cpidu_phase[2], cpidl_phase[2];
/* set up b ... */
for(int ic=0; ic<3; ic++) for(int j=0; j<2; j++) for(int k=0; k<3; k++)
bc[ic][j][k] = b[ic][j]*( k==ic ? -1 :1);
MatGetOwnershipRange(A, &ns, &ne);
for (int itrue = ns; itrue < ne && itrue < 2*Nxyzc(); ++itrue) {
Point p(itrue, Grid(N, Nc, 2)); p.project(3); int i = p.xyzcr();
int cp[2], icp[2], cidu, cpidu[2],cpidl[2], cid, cpid[2];
for(int j=0; j<2;j++){
cp[j] = (p.c()+1+j) % NC;
icp[j] = i + (cp[j]-p.c() ) *Nxyz();
cpidu[j] = cyclic(p, 2-j, N);
cpidl[j] = cyclic(p, 2-j, N);
cpid[j] = cyclic(p, 2-j, N);
cpidu_phase[j] = 1.0;
cpidl_phase[j] = 1.0;
}
cidu = cyclic(p, 0, N);
cid = cyclic(p, 0, N);
cidu_phase = 1.0;
for(int jr=0; jr<2; jr++) { /* column real/imag parts */
int jrd = (jr-p.r())*NC*Nxyz();
magicnum = (p.r()==jr)*1.0 + (p.r()<jr)*1.0*ComplexI - (p.r()>jr)*1.0* ComplexI;
//=====================================================================
Point prow(i, Grid(N,3,2)); prow.project(Nc);
for(int ib=0; ib<2; ib++){
if(p.x(p.c()) == N[p.c()]-1){
int per = periodic(p.c(), DimPeriod );
cidu = per ? (1-N[p.c()])*cid : 0;
cidu_phase = per? std::exp(ComplexI*blochbc[p.c()]) : bc[p.c()][1][cp[ib]];
}
if(p.x(cp[ib]) == 0){
int per = periodic(cp[ib], DimPeriod );
cpidl[ib] = per ? (1-N[cp[ib]])*cpid[ib] : 0;
cpidl_phase[ib] = per ? std::exp(-ComplexI*blochbc[cp[ib]]) : bc[cp[ib]][0][cp[ib]];
}
mucp[1-ib] = pmlval(icp[1-ib], N, Npml, h, LowerPML, 1);
mulcp[1-ib] = pmlval(icp[1-ib]-cpidl[ib], N, Npml, h, LowerPML, 1);
double c[4];
hh = h[p.c()]*h[cp[ib]];
val = mucp[1-ib] * magicnum /hh; c[1] = val.real();
val *= cidu_phase; c[0] = -val.real();
val = cpidl_phase[ib] * mulcp[1-ib] * magicnum/hh; c[3] = -val.real();
val *= -cidu_phase; c[2] = -val.real();
int dcol[4];
dcol[0] = cidu;
dcol[1] = 0;
dcol[2] = cidu-cpidl[ib];
dcol[3] = -cpidl[ib];
for(int w=0;w<4;w++){
Point pcol(icp[ib] + jrd+dcol[w], Grid(N,3,2) );
pcol.project(Nc);
if(pcol.c()!=-1) MatSetValue(A, prow.xyzcr()+offset, pcol.xyzcr()+offset, c[w], ADD_VALUES);
}
if(p.x(cp[ib]) == N[cp[ib]]-1){
int per = periodic(cp[ib], DimPeriod );
cpidu[ib] = per ? (1-N[cp[ib]])*cpid[ib] : 0;
cpidu_phase[ib] = per? std::exp(ComplexI*blochbc[cp[ib]]) : bc[cp[ib]][1][p.c()];
}
if(p.x(cp[ib]) == 0){
int per = periodic(cp[ib], DimPeriod );
cpidl[ib] = per ? (1-N[cp[ib]])*cpid[ib] : -cpidu[ib];
cpidl_phase[ib] = per? std::exp(-ComplexI*blochbc[cp[ib]]) : bc[cp[ib]][0][p.c()];
}
hh = h[cp[ib]]*h[cp[ib]];
val = -(cpidu_phase[ib] * mucp[1-ib] * magicnum)/hh; c[0] = -val.real();
val = +( (mucp[1-ib] + mulcp[1-ib]) * magicnum)/hh;c[1] = -val.real();
val = -(cpidl_phase[ib] * mulcp[1-ib] * magicnum)/hh;c[2] = -val.real();
dcol[0] = cpidu[ib];
dcol[1] = 0;
dcol[2] = -cpidl[ib];
for(int w=0;w<3;w++){
Point pcol(i + jrd+dcol[w], Grid(N,3,2) );
pcol.project(Nc);
if(pcol.c()!=-1) MatSetValue(A, prow.xyzcr()+offset, pcol.xyzcr()+offset, c[w], ADD_VALUES);
}
}
}
}
}
int main(int argc,char **argv) {
Mat pA,P,aijP;
PetscScalar pa[]={1.,-1.,0.,0.,1.,-1.,0.,0.,1.};
PetscInt pij[]={0,1,2};
PetscInt aij[3][3]={{0,1,2},{3,4,5},{6,7,8}};
Mat A,mC,C;
PetscScalar one=1.;
PetscErrorCode ierr;
PetscInitialize(&argc,&argv,(char *)0,help);
/* Create MAIJ matrix, P */
ierr = MatCreate(PETSC_COMM_SELF,&pA);CHKERRQ(ierr);
ierr = MatSetSizes(pA,3,3,3,3);CHKERRQ(ierr);
ierr = MatSetType(pA,MATSEQAIJ);CHKERRQ(ierr);
ierr = MatSetOption(pA,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatSetValues(pA,3,pij,3,pij,pa,ADD_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(pA,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(pA,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatCreateMAIJ(pA,3,&P);CHKERRQ(ierr);
ierr = MatDestroy(pA);
/* Create AIJ equivalent matrix, aijP, for comparison testing */
ierr = MatConvert(P,MATSEQAIJ,MAT_INITIAL_MATRIX,&aijP);
/* Create AIJ matrix, A */
ierr = MatCreate(PETSC_COMM_SELF,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,9,9,9,9);CHKERRQ(ierr);
ierr = MatSetType(A,MATSEQAIJ);CHKERRQ(ierr);
ierr = MatSetOption(A,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatSetValues(A,3,aij[0],3,aij[0],pa,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(A,3,aij[1],3,aij[1],pa,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(A,3,aij[2],3,aij[2],pa,ADD_VALUES);CHKERRQ(ierr);
{int i;
for (i=0;i<9;i++) {
ierr = MatSetValue(A,i,i,one,ADD_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Perform SeqAIJ_SeqMAIJ PtAP */
ierr = MatPtAP(A,P,MAT_INITIAL_MATRIX,1.,&mC);CHKERRQ(ierr);
ierr = MatView(mC,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
/* Perform SeqAIJ_SeqAIJ PtAP for comparison testing */
ierr = MatPtAP(A,aijP,MAT_INITIAL_MATRIX,1.,&C);CHKERRQ(ierr);
ierr = MatView(C,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
/* Perform diff of two matrices */
ierr = MatAXPY(C,-1.0,mC,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
/* Note: We should be able to use SAME_NONZERO_PATTERN on the line above, */
/* but don't because this flag doesn't assist testing. */
ierr = MatView(C,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
/* Cleanup */
ierr = MatDestroy(P);
ierr = MatDestroy(aijP);
ierr = MatDestroy(A);
ierr = MatDestroy(C);
ierr = MatDestroy(mC);
PetscFinalize();
return(0);
}
void PotentialSolve::_BuildCARTPBC(double fval) {
PetscInt local, global, pos1, pos2, Ng2;
int lo, hi, ixp, ixm, iyp, iym, izp, izm;
// Collect rows and push once at a time
PetscInt idxm[1], idxn[7];
PetscScalar val[7];
// Get sizes
_dg1.size(local, global);
// Allocate maximum values of diagonal and off-diagonal memory
// This is a little wasteful, but it simplifies the amount you need to think
MatCreateMPIAIJ(PETSC_COMM_WORLD, local, local, global, global,7, PETSC_NULL, 2, PETSC_NULL, &a);
_dg1.slab(lo, hi);
Ng2 = Ng+2;
// Now fill in the matrix -- do this in the maximally dumb way. Easier to debug.
for (int ix=lo; ix < hi; ++ix) {
ixp = (ix+1)%Ng;
ixm = (ix-1+Ng)%Ng;
for (int iy=0; iy < Ng; ++iy) {
iyp = (iy+1)%Ng;
iym = (iy-1+Ng)%Ng;
for (int iz=0; iz < Ng; ++iz) {
izp = (iz+1)%Ng;
izm = (iz-1+Ng)%Ng;
pos1 = (ix*Ng+iy)*Ng2 + iz ;
idxn[0]=pos1;
val[0] = (-6.0-2.0*fval)/(dx*dx);
pos2 = (ixp*Ng+iy)*Ng2 + iz;
idxn[1]=pos2;
val[1] = 1.0/(dx*dx);
pos2 = (ixm*Ng+iy)*Ng2 + iz;
idxn[2]=pos2;
val[2] = 1.0/(dx*dx);
pos2 = (ix*Ng+iyp)*Ng2 + iz;
idxn[3]=pos2;
val[3] = 1.0/(dx*dx);
pos2 = (ix*Ng+iym)*Ng2 + iz;
idxn[4]=pos2;
val[4] = 1.0/(dx*dx);
pos2 = (ix*Ng+iy)*Ng2 + izp;
idxn[5]=pos2;
val[5] = (1.0+fval)/(dx*dx);
pos2 = (ix*Ng+iy)*Ng2 + izm;
idxn[6]=pos2;
val[6] = (1.0+fval)/(dx*dx);
idxm[0] = pos1;
MatSetValues(a, 1, idxm, 7, idxn, val, INSERT_VALUES);
}
// Special case the padded region to ensure that the const function is still in the NULL space
pos1 = (ix*Ng+iy)*Ng2 + Ng;
pos2 = pos1+1;
MatSetValue(a, pos1, pos1, 1.0/(dx*dx), INSERT_VALUES);
MatSetValue(a, pos2, pos2, 1.0/(dx*dx), INSERT_VALUES);
MatSetValue(a, pos1, pos2, -1.0/(dx*dx), INSERT_VALUES);
MatSetValue(a, pos2, pos1, -1.0/(dx*dx), INSERT_VALUES);
}
}
MatAssemblyBegin(a,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(a,MAT_FINAL_ASSEMBLY);
}
/*
FormJacobian1 - Evaluates Jacobian matrix.
Input Parameters:
. snes - the SNES context
. x - input vector
. dummy - optional user-defined context (not used here)
Output Parameters:
. jac - Jacobian matrix
. B - optionally different preconditioning matrix
. flag - flag indicating matrix structure
*/
PetscErrorCode FormJacobian1(SNES snes,Vec x,Mat *jac,Mat *B,MatStructure *flag,void *ictx)
{
PetscScalar *xx;
PetscErrorCode ierr;
PetscInt i;
Ctx *ctx = (Ctx*)ictx;
ierr = MatZeroEntries(*B);CHKERRQ(ierr);
/*
Get pointer to vector data
*/
ierr = VecGetArray(x,&xx);CHKERRQ(ierr);
/*
Compute Jacobian entries and insert into matrix.
- Since this is such a small problem, we set all entries for
the matrix at once.
*/
ierr = MatSetValue(*B,0,0, 2.0 + 1200.0*xx[0]*xx[0] - 400.0*xx[1],ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(*B,0,1,-400.0*xx[0],ADD_VALUES);CHKERRQ(ierr);
for (i=1; i<ctx->p+1; i++) {
ierr = MatSetValue(*B,i,i-1, -400.0*xx[i-1],ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(*B,i,i, 2.0 + 1200.0*xx[i]*xx[i] - 400.0*xx[i+1] + 200.0,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(*B,i,i+1,-400.0*xx[i],ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatSetValue(*B,ctx->p+1,ctx->p, -400.0*xx[ctx->p],ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(*B,ctx->p+1,ctx->p+1,200,ADD_VALUES);CHKERRQ(ierr);
*flag = SAME_NONZERO_PATTERN;
for (i=ctx->p+2; i<2+ctx->p+ctx->n; i++) {
ierr = MatSetValue(*B,i,i,1.0,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(*B,i,0,-1.0,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(*B,i,1,.7,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(*B,i,i-1,-.4*xx[i-1],ADD_VALUES);CHKERRQ(ierr);
}
/*
Restore vector
*/
ierr = VecRestoreArray(x,&xx);CHKERRQ(ierr);
/*
Assemble matrix
*/
ierr = MatAssemblyBegin(*B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (*jac != *B) {
ierr = MatAssemblyBegin(*jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
return 0;
}
void PotentialSolve::_BuildRADIAL(double fval, vector<double>& origin) {
PetscInt local, global, pos1, pos2, Ng2;
int lo, hi, ixp, ixm, iyp, iym, izp, izm;
double x, y, z, rr2, rsd, dx2;
dx2 = dx*dx;
// Collect rows and push once at a time
PetscInt idxm[1], idxn[19];
PetscScalar val[19];
// Get sizes
_dg1.size(local, global);
MatCreateMPIAIJ(PETSC_COMM_WORLD, local, local, global, global,19, PETSC_NULL, 10, PETSC_NULL, &a);
_dg1.slab(lo, hi);
Ng2 = Ng+2;
// Now fill in the matrix -- do this in the maximally dumb way. Easier to debug.
for (int ix=lo; ix < hi; ++ix) {
ixp = (ix+1)%Ng;
ixm = (ix-1+Ng)%Ng;
for (int iy=0; iy < Ng; ++iy) {
iyp = (iy+1)%Ng;
iym = (iy-1+Ng)%Ng;
for (int iz=0; iz < Ng; ++iz) {
izp = (iz+1)%Ng;
izm = (iz-1+Ng)%Ng;
// Start by doing the coordinate geometry and setting xx,yy,zz
x = double(ix)*dx - origin[0];
y = double(iy)*dx - origin[1];
z = double(iz)*dx - origin[2];
rr2 = x*x + y*y + z*z + 1.e-5; // If the origin coincides with a grid cell
// Now set the various matrix terms. There are 19 terms, and some organizing principles.
// See python/spherical_v2.py and python/spherical_v2.tex for the redshift space terms
// As always, do the maximally dumb way, for ease of debugging
// (0,0,0) - unchanged from the normal case
pos1 = (ix*Ng+iy)*Ng2 + iz;
idxm[0] = pos1;
idxn[0] = pos1;
val[0] = (-6.0-2.0*fval)/(dx*dx);
// (1,0,0)
rsd = (x*x)/(dx2*rr2) + x/(dx*rr2);
idxn[1] = (ixp*Ng+iy)*Ng2 + iz;
val[1]=1.0/(dx2) + fval*rsd;
// (-1,0,0)
rsd = (x*x)/(dx2*rr2) - x/(dx*rr2);
idxn[2] = (ixm*Ng+iy)*Ng2 + iz;
val[2]=1.0/(dx2) + fval*rsd;
// (0,1,0)
rsd = (y*y)/(dx2*rr2) + y/(dx*rr2);
idxn[3]= (ix*Ng+iyp)*Ng2 + iz;
val[3]=1.0/(dx2) + fval*rsd;
// (0,-1,0)
rsd = (y*y)/(dx2*rr2) - y/(dx*rr2);
idxn[4]= (ix*Ng+iym)*Ng2 + iz;
val[4]=1.0/(dx2) + fval*rsd;
// (0,0,1)
rsd = (z*z)/(dx2*rr2) + z/(dx*rr2);
idxn[5] = (ix*Ng+iy)*Ng2 + izp;
val[5]=1.0/(dx2) + fval*rsd;
// (0,0,-1)
rsd = (z*z)/(dx2*rr2) - z/(dx*rr2);
idxn[6] = (ix*Ng+iy)*Ng2 + izm;
val[6]=1.0/(dx2) + fval*rsd;
// (-1,-1,0), (1,1,0), (-1,1,0), (1,-1,0)
rsd = (x*y)/(2*dx2*rr2);
idxn[ 7] = (ixm*Ng+iym)*Ng2 + iz;
val[ 7] = fval*rsd;
idxn[ 8] = (ixp*Ng+iyp)*Ng2 + iz;
val[ 8] = fval*rsd;
idxn[ 9] = (ixm*Ng+iyp)*Ng2 + iz;
val[ 9] = -fval*rsd;
idxn[10] = (ixp*Ng+iym)*Ng2 + iz;
val[10] = -fval*rsd;
// (-1,0,-1), (1,0,1), (-1,0,1), (1,0,-1)
rsd = (x*z)/(2*dx2*rr2);
idxn[11] = (ixm*Ng+iy)*Ng2 + izm;
val[11] = fval*rsd;
idxn[12] = (ixp*Ng+iy)*Ng2 + izp;
val[12] = fval*rsd;
idxn[13] = (ixm*Ng+iy)*Ng2 + izp;
val[13] = -fval*rsd;
idxn[14] = (ixp*Ng+iy)*Ng2 + izm;
val[14] = -fval*rsd;
// (0,-1,-1), (0,1,1), (0,-1,1), (0,1,-1)
rsd = (y*z)/(2*dx2*rr2);
idxn[15] = (ix*Ng+iym)*Ng2 + izm;
val[15] = fval*rsd;
idxn[16] = (ix*Ng+iyp)*Ng2 + izp;
val[16] = fval*rsd;
idxn[17] = (ix*Ng+iym)*Ng2 + izp;
val[17] = -fval*rsd;
idxn[18] = (ix*Ng+iyp)*Ng2 + izm;
val[18] = -fval*rsd;
MatSetValues(a, 1, idxm, 19, idxn, val, INSERT_VALUES);
}
// Special case the padded region to ensure that the const function is still in the NULL space
pos1 = (ix*Ng+iy)*Ng2 + Ng;
pos2 = pos1+1;
MatSetValue(a, pos1, pos1, 1.0/(dx*dx), INSERT_VALUES);
MatSetValue(a, pos2, pos2, 1.0/(dx*dx), INSERT_VALUES);
MatSetValue(a, pos1, pos2, -1.0/(dx*dx), INSERT_VALUES);
MatSetValue(a, pos2, pos1, -1.0/(dx*dx), INSERT_VALUES);
}
}
MatAssemblyBegin(a,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(a,MAT_FINAL_ASSEMBLY);
}
/*
* steady_state solves for the steady_state of the system
* that was previously setup using the add_to_ham and add_lin
* routines. Solver selection and parameterscan be controlled via PETSc
* command line options.
*/
void steady_state(Vec x){
PetscViewer mat_view;
PC pc;
Vec b;
KSP ksp; /* linear solver context */
PetscInt row,col,its,j,i,Istart,Iend;
PetscScalar mat_tmp;
long dim;
int num_pop;
double *populations;
Mat solve_A;
if (_lindblad_terms) {
dim = total_levels*total_levels;
solve_A = full_A;
if (nid==0) {
printf("Lindblad terms found, using Lindblad solver.");
}
} else {
if (nid==0) {
printf("Warning! Steady state not supported for Schrodinger.\n");
printf(" Defaulting to (less efficient) Lindblad Solver\n");
exit(0);
}
dim = total_levels*total_levels;
solve_A = ham_A;
}
if (!stab_added){
if (nid==0) printf("Adding stabilization...\n");
/*
* Add elements to the matrix to make the normalization work
* I have no idea why this works, I am copying it from qutip
* We add 1.0 in the 0th spot and every n+1 after
*/
if (nid==0) {
row = 0;
for (i=0;i<total_levels;i++){
col = i*(total_levels+1);
mat_tmp = 1.0 + 0.*PETSC_i;
MatSetValue(full_A,row,col,mat_tmp,ADD_VALUES);
}
/* Print dense ham, if it was asked for */
if (_print_dense_ham){
FILE *fp_ham;
fp_ham = fopen("ham","w");
if (nid==0){
for (i=0;i<total_levels;i++){
for (j=0;j<total_levels;j++){
fprintf(fp_ham,"%e %e ",PetscRealPart(_hamiltonian[i][j]),PetscImaginaryPart(_hamiltonian[i][j]));
}
fprintf(fp_ham,"\n");
}
}
fclose(fp_ham);
for (i=0;i<total_levels;i++){
free(_hamiltonian[i]);
}
free(_hamiltonian);
_print_dense_ham = 0;
}
}
stab_added = 1;
}
// if (!matrix_assembled) {
MatGetOwnershipRange(full_A,&Istart,&Iend);
/*
* Explicitly add 0.0 to all diagonal elements;
* this fixes a 'matrix in wrong state' message that PETSc
* gives if the diagonal was never initialized.
*/
if (nid==0) printf("Adding 0 to diagonal elements...\n");
for (i=Istart;i<Iend;i++){
mat_tmp = 0 + 0.*PETSC_i;
MatSetValue(full_A,i,i,mat_tmp,ADD_VALUES);
}
/* Tell PETSc to assemble the matrix */
MatAssemblyBegin(full_A,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(full_A,MAT_FINAL_ASSEMBLY);
if (nid==0) printf("Matrix Assembled.\n");
matrix_assembled = 1;
// }
/* Print information about the matrix. */
PetscViewerASCIIOpen(PETSC_COMM_WORLD,NULL,&mat_view);
PetscViewerPushFormat(mat_view,PETSC_VIEWER_ASCII_INFO);
MatView(full_A,mat_view);
PetscViewerPopFormat(mat_view);
PetscViewerDestroy(&mat_view);
/*
* Create parallel vectors.
* - When using VecCreate(), VecSetSizes() and VecSetFromOptions(),
* we specify only the vector's global
* dimension; the parallel partitioning is determined at runtime.
* - Note: We form 1 vector from scratch and then duplicate as needed.
*/
VecCreate(PETSC_COMM_WORLD,&b);
VecSetSizes(b,PETSC_DECIDE,dim);
VecSetFromOptions(b);
// VecDuplicate(b,&x); Assume x is passed in
/*
* Set rhs, b, and solution, x to 1.0 in the first
* element, 0.0 elsewhere.
*/
VecSet(b,0.0);
VecSet(x,0.0);
if(nid==0) {
row = 0;
mat_tmp = 1.0 + 0.0*PETSC_i;
VecSetValue(x,row,mat_tmp,INSERT_VALUES);
VecSetValue(b,row,mat_tmp,INSERT_VALUES);
}
/* Assemble x and b */
VecAssemblyBegin(x);
VecAssemblyEnd(x);
VecAssemblyBegin(b);
VecAssemblyEnd(b);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*
* Create the linear solver and set various options *
*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
* Create linear solver context
*/
KSPCreate(PETSC_COMM_WORLD,&ksp);
/*
* Set operators. Here the matrix that defines the linear system
* also serves as the preconditioning matrix.
*/
KSPSetOperators(ksp,full_A,full_A);
/*
* Set good default options for solver
*/
/* relative tolerance */
KSPSetTolerances(ksp,default_rtol,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);
/* bjacobi preconditioner */
KSPGetPC(ksp,&pc);
PCSetType(pc,PCASM);
/* gmres solver with 100 restart*/
KSPSetType(ksp,KSPGMRES);
KSPGMRESSetRestart(ksp,default_restart);
/*
* Set runtime options, e.g.,
* -ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
*/
KSPSetFromOptions(ksp);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
if (nid==0) printf("KSP set. Solving for steady state...\n");
KSPSolve(ksp,b,x);
num_pop = get_num_populations();
populations = malloc(num_pop*sizeof(double));
get_populations(x,&populations);
if(nid==0){
printf("Final populations: ");
for(i=0;i<num_pop;i++){
printf(" %e ",populations[i]);
}
printf("\n");
}
KSPGetIterationNumber(ksp,&its);
PetscPrintf(PETSC_COMM_WORLD,"Iterations %D\n",its);
/* Free work space */
KSPDestroy(&ksp);
// VecDestroy(&x);
VecDestroy(&b);
return;
}
int main(int argc, char** argv)
{
/* the total number of grid points in each spatial direction is (n+1) */
/* the total number of degrees-of-freedom in each spatial direction is (n-1) */
/* this version requires n to be a power of 2 */
if( argc < 2 ) {
printf("need a problem size\n");
return 1;
}
int n = atoi(argv[1]);
int m = n-1;
// Initialize Petsc
PetscInitialize(&argc,&argv,0,PETSC_NULL);
// Create our vector
Vec b;
VecCreate(PETSC_COMM_WORLD,&b);
VecSetSizes(b,m*m,PETSC_DECIDE);
VecSetFromOptions(b);
VecSetUp(b);
// Create our matrix
Mat A;
MatCreate(PETSC_COMM_WORLD,&A);
MatSetType(A,MATSEQAIJ);
MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,m*m,m*m);
MatSetUp(A);
// Create linear solver object
KSP ksp;
KSPCreate(PETSC_COMM_WORLD,&ksp);
// setup rhs
PetscInt low, high;
VecGetOwnershipRange(b,&low,&high);
PetscInt* inds = (PetscInt*)malloc((high-low)*sizeof(PetscInt));
double* vals = (double*)malloc((high-low)*sizeof(double));
double h = 1./(double)n;
for (int i=0;i<high-1;++i) {
inds[i] = low+i;
vals[i] = h*h;
}
VecSetValues(b,high-low,inds,vals,INSERT_VALUES);
free(inds);
free(vals);
// setup matrix
for (int i=0;i<m*m;++i) {
MatSetValue(A,i,i,4.f,INSERT_VALUES);
if (i%m != m-1)
MatSetValue(A,i,i+1,-1.f,INSERT_VALUES);
if (i%m)
MatSetValue(A,i,i-1,-1.f,INSERT_VALUES);
if (i > m)
MatSetValue(A,i,i-m,-1.f,INSERT_VALUES);
if (i < m*(m-1))
MatSetValue(A,i,i+m,-1.f,INSERT_VALUES);
}
// sync processes
VecAssemblyBegin(b);
VecAssemblyEnd(b);
MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);
// solve
KSPSetType(ksp,"cg");
KSPSetTolerances(ksp,1.e-10,1.e-10,1.e6,10000);
KSPSetOperators(ksp,A,A,SAME_NONZERO_PATTERN);
PC pc;
KSPGetPC(ksp,&pc);
PCSetType(pc,"ilu");
PCSetFromOptions(pc);
PCSetUp(pc);
// setup solver
KSPSetFromOptions(ksp);
KSPSetUp(ksp);
Vec x;
VecDuplicate(b,&x);
KSPSolve(ksp,b,x);
double val;
VecNorm(x,NORM_INFINITY,&val);
printf (" umax = %e \n",val);
PetscFinalize();
return 0;
}
int main(int argc,char **argv)
{
Mat M,C,K,A[3]; /* problem matrices */
PEP pep; /* polynomial eigenproblem solver context */
PetscInt n=5,Istart,Iend,i;
PetscReal mu=1,tau=10,kappa=5;
PetscBool terse;
PetscErrorCode ierr;
PetscLogDouble time1,time2;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-mu",&mu,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-tau",&tau,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-kappa",&kappa,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nDamped mass-spring system, n=%D mu=%g tau=%g kappa=%g\n\n",n,(double)mu,(double)tau,(double)kappa);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrices that define the eigensystem, (k^2*M+k*C+K)x=0
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* K is a tridiagonal */
ierr = MatCreate(PETSC_COMM_WORLD,&K);CHKERRQ(ierr);
ierr = MatSetSizes(K,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(K);CHKERRQ(ierr);
ierr = MatSetUp(K);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(K,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
if (i>0) {
ierr = MatSetValue(K,i,i-1,-kappa,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatSetValue(K,i,i,kappa*3.0,INSERT_VALUES);CHKERRQ(ierr);
if (i<n-1) {
ierr = MatSetValue(K,i,i+1,-kappa,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(K,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(K,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* C is a tridiagonal */
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
if (i>0) {
ierr = MatSetValue(C,i,i-1,-tau,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatSetValue(C,i,i,tau*3.0,INSERT_VALUES);CHKERRQ(ierr);
if (i<n-1) {
ierr = MatSetValue(C,i,i+1,-tau,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* M is a diagonal matrix */
ierr = MatCreate(PETSC_COMM_WORLD,&M);CHKERRQ(ierr);
ierr = MatSetSizes(M,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(M);CHKERRQ(ierr);
ierr = MatSetUp(M);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(M,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
ierr = MatSetValue(M,i,i,mu,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and solve the problem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PEPCreate(PETSC_COMM_WORLD,&pep);CHKERRQ(ierr);
A[0] = K; A[1] = C; A[2] = M;
ierr = PEPSetOperators(pep,3,A);CHKERRQ(ierr);
ierr = PEPSetFromOptions(pep);CHKERRQ(ierr);
ierr = PetscTime(&time1); CHKERRQ(ierr);
ierr = PEPSolve(pep);CHKERRQ(ierr);
ierr = PetscTime(&time2); CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* show detailed info unless -terse option is given by user */
ierr = PetscOptionsHasName(NULL,"-terse",&terse);CHKERRQ(ierr);
if (terse) {
ierr = PEPErrorView(pep,PEP_ERROR_BACKWARD,NULL);CHKERRQ(ierr);
} else {
ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO_DETAIL);CHKERRQ(ierr);
ierr = PEPReasonView(pep,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PEPErrorView(pep,PEP_ERROR_BACKWARD,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"Time: %g\n\n\n",time2-time1);CHKERRQ(ierr);
ierr = PEPDestroy(&pep);CHKERRQ(ierr);
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&K);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **args)
{
Mat A,RHS,C,F,X,S;
Vec u,x,b;
Vec xschur,bschur,uschur;
IS is_schur;
PetscErrorCode ierr;
PetscMPIInt size;
PetscInt isolver=0,size_schur,m,n,nfact,nsolve,nrhs;
PetscReal norm,tol=PETSC_SQRT_MACHINE_EPSILON;
PetscRandom rand;
PetscBool data_provided,herm,symm,use_lu;
PetscReal sratio = 5.1/12.;
PetscViewer fd; /* viewer */
char solver[256];
char file[PETSC_MAX_PATH_LEN]; /* input file name */
PetscInitialize(&argc,&args,(char*)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD, &size);CHKERRQ(ierr);
if (size > 1) SETERRQ(PETSC_COMM_WORLD,1,"This is a uniprocessor test");
/* Determine which type of solver we want to test for */
herm = PETSC_FALSE;
symm = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,NULL,"-symmetric_solve",&symm,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,NULL,"-hermitian_solve",&herm,NULL);CHKERRQ(ierr);
if (herm) symm = PETSC_TRUE;
/* Determine file from which we read the matrix A */
ierr = PetscOptionsGetString(NULL,NULL,"-f",file,PETSC_MAX_PATH_LEN,&data_provided);CHKERRQ(ierr);
if (!data_provided) { /* get matrices from PETSc distribution */
sprintf(file,PETSC_DIR);
ierr = PetscStrcat(file,"/share/petsc/datafiles/matrices/");CHKERRQ(ierr);
if (symm) {
#if defined (PETSC_USE_COMPLEX)
ierr = PetscStrcat(file,"hpd-complex-");CHKERRQ(ierr);
#else
ierr = PetscStrcat(file,"spd-real-");CHKERRQ(ierr);
#endif
} else {
#if defined (PETSC_USE_COMPLEX)
ierr = PetscStrcat(file,"nh-complex-");CHKERRQ(ierr);
#else
ierr = PetscStrcat(file,"ns-real-");CHKERRQ(ierr);
#endif
}
#if defined(PETSC_USE_64BIT_INDICES)
ierr = PetscStrcat(file,"int64-");CHKERRQ(ierr);
#else
ierr = PetscStrcat(file,"int32-");CHKERRQ(ierr);
#endif
#if defined (PETSC_USE_REAL_SINGLE)
ierr = PetscStrcat(file,"float32");CHKERRQ(ierr);
#else
ierr = PetscStrcat(file,"float64");CHKERRQ(ierr);
#endif
}
/* Load matrix A */
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file,FILE_MODE_READ,&fd);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatLoad(A,fd);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&fd);CHKERRQ(ierr);
ierr = MatGetSize(A,&m,&n);CHKERRQ(ierr);
if (m != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ, "This example is not intended for rectangular matrices (%d, %d)", m, n);
/* Create dense matrix C and X; C holds true solution with identical colums */
nrhs = 2;
ierr = PetscOptionsGetInt(NULL,NULL,"-nrhs",&nrhs,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,m,PETSC_DECIDE,PETSC_DECIDE,nrhs);CHKERRQ(ierr);
ierr = MatSetType(C,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rand);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rand);CHKERRQ(ierr);
ierr = MatSetRandom(C,rand);CHKERRQ(ierr);
ierr = MatDuplicate(C,MAT_DO_NOT_COPY_VALUES,&X);CHKERRQ(ierr);
/* Create vectors */
ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr);
ierr = VecSetSizes(x,n,PETSC_DECIDE);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&b);CHKERRQ(ierr);
ierr = VecDuplicate(x,&u);CHKERRQ(ierr); /* save the true solution */
ierr = PetscOptionsGetInt(NULL,NULL,"-solver",&isolver,NULL);CHKERRQ(ierr);
switch (isolver) {
#if defined(PETSC_HAVE_MUMPS)
case 0:
ierr = PetscStrcpy(solver,MATSOLVERMUMPS);CHKERRQ(ierr);
break;
#endif
#if defined(PETSC_HAVE_MKL_PARDISO)
case 1:
ierr = PetscStrcpy(solver,MATSOLVERMKL_PARDISO);CHKERRQ(ierr);
break;
#endif
default:
ierr = PetscStrcpy(solver,MATSOLVERPETSC);CHKERRQ(ierr);
break;
}
#if defined (PETSC_USE_COMPLEX)
if (isolver == 0 && symm && !data_provided) { /* MUMPS (5.0.0) does not have support for hermitian matrices, so make them symmetric */
PetscScalar im = PetscSqrtScalar((PetscScalar)-1.);
PetscScalar val = -1.0;
val = val + im;
ierr = MatSetValue(A,1,0,val,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
#endif
ierr = PetscOptionsGetReal(NULL,NULL,"-schur_ratio",&sratio,NULL);CHKERRQ(ierr);
if (sratio < 0. || sratio > 1.) {
SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ, "Invalid ratio for schur degrees of freedom %f", sratio);
}
size_schur = (PetscInt)(sratio*m);
ierr = PetscPrintf(PETSC_COMM_SELF,"Solving with %s: nrhs %d, sym %d, herm %d, size schur %d, size mat %d\n",solver,nrhs,symm,herm,size_schur,m);CHKERRQ(ierr);
/* Test LU/Cholesky Factorization */
use_lu = PETSC_FALSE;
if (!symm) use_lu = PETSC_TRUE;
#if defined (PETSC_USE_COMPLEX)
if (isolver == 1) use_lu = PETSC_TRUE;
#endif
if (herm && !use_lu) { /* test also conversion routines inside the solver packages */
ierr = MatSetOption(A,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatConvert(A,MATSEQSBAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
}
if (use_lu) {
ierr = MatGetFactor(A,solver,MAT_FACTOR_LU,&F);CHKERRQ(ierr);
} else {
if (herm) {
ierr = MatSetOption(A,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatSetOption(A,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
} else {
ierr = MatSetOption(A,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatSetOption(A,MAT_SPD,PETSC_FALSE);CHKERRQ(ierr);
}
ierr = MatGetFactor(A,solver,MAT_FACTOR_CHOLESKY,&F);CHKERRQ(ierr);
}
ierr = ISCreateStride(PETSC_COMM_SELF,size_schur,m-size_schur,1,&is_schur);CHKERRQ(ierr);
ierr = MatFactorSetSchurIS(F,is_schur);CHKERRQ(ierr);
ierr = ISDestroy(&is_schur);CHKERRQ(ierr);
if (use_lu) {
ierr = MatLUFactorSymbolic(F,A,NULL,NULL,NULL);CHKERRQ(ierr);
} else {
ierr = MatCholeskyFactorSymbolic(F,A,NULL,NULL);CHKERRQ(ierr);
}
for (nfact = 0; nfact < 3; nfact++) {
Mat AD;
if (!nfact) {
ierr = VecSetRandom(x,rand);CHKERRQ(ierr);
if (symm && herm) {
ierr = VecAbs(x);CHKERRQ(ierr);
}
ierr = MatDiagonalSet(A,x,ADD_VALUES);CHKERRQ(ierr);
}
if (use_lu) {
ierr = MatLUFactorNumeric(F,A,NULL);CHKERRQ(ierr);
} else {
ierr = MatCholeskyFactorNumeric(F,A,NULL);CHKERRQ(ierr);
}
ierr = MatFactorCreateSchurComplement(F,&S);CHKERRQ(ierr);
ierr = MatCreateVecs(S,&xschur,&bschur);CHKERRQ(ierr);
ierr = VecDuplicate(xschur,&uschur);CHKERRQ(ierr);
if (nfact == 1) {
ierr = MatFactorInvertSchurComplement(F);CHKERRQ(ierr);
}
for (nsolve = 0; nsolve < 2; nsolve++) {
ierr = VecSetRandom(x,rand);CHKERRQ(ierr);
ierr = VecCopy(x,u);CHKERRQ(ierr);
if (nsolve) {
ierr = MatMult(A,x,b);CHKERRQ(ierr);
ierr = MatSolve(F,b,x);CHKERRQ(ierr);
} else {
ierr = MatMultTranspose(A,x,b);CHKERRQ(ierr);
ierr = MatSolveTranspose(F,b,x);CHKERRQ(ierr);
}
/* Check the error */
ierr = VecAXPY(u,-1.0,x);CHKERRQ(ierr); /* u <- (-1.0)x + u */
ierr = VecNorm(u,NORM_2,&norm);CHKERRQ(ierr);
if (norm > tol) {
PetscReal resi;
if (nsolve) {
ierr = MatMult(A,x,u);CHKERRQ(ierr); /* u = A*x */
} else {
ierr = MatMultTranspose(A,x,u);CHKERRQ(ierr); /* u = A*x */
}
ierr = VecAXPY(u,-1.0,b);CHKERRQ(ierr); /* u <- (-1.0)b + u */
ierr = VecNorm(u,NORM_2,&resi);CHKERRQ(ierr);
if (nsolve) {
ierr = PetscPrintf(PETSC_COMM_SELF,"(f %d, s %d) MatSolve error: Norm of error %g, residual %f\n",nfact,nsolve,norm,resi);CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_SELF,"(f %d, s %d) MatSolveTranspose error: Norm of error %g, residual %f\n",nfact,nsolve,norm,resi);CHKERRQ(ierr);
}
}
ierr = VecSetRandom(xschur,rand);CHKERRQ(ierr);
ierr = VecCopy(xschur,uschur);CHKERRQ(ierr);
if (nsolve) {
ierr = MatMult(S,xschur,bschur);CHKERRQ(ierr);
ierr = MatFactorSolveSchurComplement(F,bschur,xschur);CHKERRQ(ierr);
} else {
ierr = MatMultTranspose(S,xschur,bschur);CHKERRQ(ierr);
ierr = MatFactorSolveSchurComplementTranspose(F,bschur,xschur);CHKERRQ(ierr);
}
/* Check the error */
ierr = VecAXPY(uschur,-1.0,xschur);CHKERRQ(ierr); /* u <- (-1.0)x + u */
ierr = VecNorm(uschur,NORM_2,&norm);CHKERRQ(ierr);
if (norm > tol) {
PetscReal resi;
if (nsolve) {
ierr = MatMult(S,xschur,uschur);CHKERRQ(ierr); /* u = A*x */
} else {
ierr = MatMultTranspose(S,xschur,uschur);CHKERRQ(ierr); /* u = A*x */
}
ierr = VecAXPY(uschur,-1.0,bschur);CHKERRQ(ierr); /* u <- (-1.0)b + u */
ierr = VecNorm(uschur,NORM_2,&resi);CHKERRQ(ierr);
if (nsolve) {
ierr = PetscPrintf(PETSC_COMM_SELF,"(f %d, s %d) MatFactorSolveSchurComplement error: Norm of error %g, residual %f\n",nfact,nsolve,norm,resi);CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_SELF,"(f %d, s %d) MatFactorSolveSchurComplementTranspose error: Norm of error %g, residual %f\n",nfact,nsolve,norm,resi);CHKERRQ(ierr);
}
}
}
ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&AD);
if (!nfact) {
ierr = MatMatMult(AD,C,MAT_INITIAL_MATRIX,2.0,&RHS);CHKERRQ(ierr);
} else {
ierr = MatMatMult(AD,C,MAT_REUSE_MATRIX,2.0,&RHS);CHKERRQ(ierr);
}
ierr = MatDestroy(&AD);CHKERRQ(ierr);
for (nsolve = 0; nsolve < 2; nsolve++) {
ierr = MatMatSolve(F,RHS,X);CHKERRQ(ierr);
/* Check the error */
ierr = MatAXPY(X,-1.0,C,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatNorm(X,NORM_FROBENIUS,&norm);CHKERRQ(ierr);
if (norm > tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"(f %D, s %D) MatMatSolve: Norm of error %g\n",nfact,nsolve,norm);CHKERRQ(ierr);
}
}
ierr = MatDestroy(&S);CHKERRQ(ierr);
ierr = VecDestroy(&xschur);CHKERRQ(ierr);
ierr = VecDestroy(&bschur);CHKERRQ(ierr);
ierr = VecDestroy(&uschur);CHKERRQ(ierr);
}
/* Free data structures */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&F);CHKERRQ(ierr);
ierr = MatDestroy(&X);CHKERRQ(ierr);
ierr = MatDestroy(&RHS);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rand);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **argv)
{
Mat A[NMAT]; /* problem matrices */
PEP pep; /* polynomial eigenproblem solver context */
PetscInt n,m=8,k,II,Istart,Iend,i,j;
PetscReal c[10] = { 0.6, 1.3, 1.3, 0.1, 0.1, 1.2, 1.0, 1.0, 1.2, 1.0 };
PetscBool flg;
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-m",&m,NULL);CHKERRQ(ierr);
n = m*m;
k = 10;
ierr = PetscOptionsGetRealArray(NULL,"-c",c,&k,&flg);CHKERRQ(ierr);
if (flg && k!=10) SETERRQ1(PETSC_COMM_WORLD,1,"The number of parameters -c should be 10, you provided %D",k);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nButterfly problem, n=%D (m=%D)\n\n",n,m);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the polynomial matrices
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* initialize matrices */
for (i=0;i<NMAT;i++) {
ierr = MatCreate(PETSC_COMM_WORLD,&A[i]);CHKERRQ(ierr);
ierr = MatSetSizes(A[i],PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A[i]);CHKERRQ(ierr);
ierr = MatSetUp(A[i]);CHKERRQ(ierr);
}
ierr = MatGetOwnershipRange(A[0],&Istart,&Iend);CHKERRQ(ierr);
/* A0 */
for (II=Istart;II<Iend;II++) {
i = II/m; j = II-i*m;
ierr = MatSetValue(A[0],II,II,4.0*c[0]/6.0+4.0*c[1]/6.0,INSERT_VALUES);CHKERRQ(ierr);
if (j>0) { ierr = MatSetValue(A[0],II,II-1,c[0]/6.0,INSERT_VALUES);CHKERRQ(ierr); }
if (j<m-1) { ierr = MatSetValue(A[0],II,II+1,c[0]/6.0,INSERT_VALUES);CHKERRQ(ierr); }
if (i>0) { ierr = MatSetValue(A[0],II,II-m,c[1]/6.0,INSERT_VALUES);CHKERRQ(ierr); }
if (i<m-1) { ierr = MatSetValue(A[0],II,II+m,c[1]/6.0,INSERT_VALUES);CHKERRQ(ierr); }
}
/* A1 */
for (II=Istart;II<Iend;II++) {
i = II/m; j = II-i*m;
if (j>0) { ierr = MatSetValue(A[1],II,II-1,c[2],INSERT_VALUES);CHKERRQ(ierr); }
if (j<m-1) { ierr = MatSetValue(A[1],II,II+1,-c[2],INSERT_VALUES);CHKERRQ(ierr); }
if (i>0) { ierr = MatSetValue(A[1],II,II-m,c[3],INSERT_VALUES);CHKERRQ(ierr); }
if (i<m-1) { ierr = MatSetValue(A[1],II,II+m,-c[3],INSERT_VALUES);CHKERRQ(ierr); }
}
/* A2 */
for (II=Istart;II<Iend;II++) {
i = II/m; j = II-i*m;
ierr = MatSetValue(A[2],II,II,-2.0*c[4]-2.0*c[5],INSERT_VALUES);CHKERRQ(ierr);
if (j>0) { ierr = MatSetValue(A[2],II,II-1,c[4],INSERT_VALUES);CHKERRQ(ierr); }
if (j<m-1) { ierr = MatSetValue(A[2],II,II+1,c[4],INSERT_VALUES);CHKERRQ(ierr); }
if (i>0) { ierr = MatSetValue(A[2],II,II-m,c[5],INSERT_VALUES);CHKERRQ(ierr); }
if (i<m-1) { ierr = MatSetValue(A[2],II,II+m,c[5],INSERT_VALUES);CHKERRQ(ierr); }
}
/* A3 */
for (II=Istart;II<Iend;II++) {
i = II/m; j = II-i*m;
if (j>0) { ierr = MatSetValue(A[3],II,II-1,c[6],INSERT_VALUES);CHKERRQ(ierr); }
if (j<m-1) { ierr = MatSetValue(A[3],II,II+1,-c[6],INSERT_VALUES);CHKERRQ(ierr); }
if (i>0) { ierr = MatSetValue(A[3],II,II-m,c[7],INSERT_VALUES);CHKERRQ(ierr); }
if (i<m-1) { ierr = MatSetValue(A[3],II,II+m,-c[7],INSERT_VALUES);CHKERRQ(ierr); }
}
/* A4 */
for (II=Istart;II<Iend;II++) {
i = II/m; j = II-i*m;
ierr = MatSetValue(A[4],II,II,2.0*c[8]+2.0*c[9],INSERT_VALUES);CHKERRQ(ierr);
if (j>0) { ierr = MatSetValue(A[4],II,II-1,-c[8],INSERT_VALUES);CHKERRQ(ierr); }
if (j<m-1) { ierr = MatSetValue(A[4],II,II+1,-c[8],INSERT_VALUES);CHKERRQ(ierr); }
if (i>0) { ierr = MatSetValue(A[4],II,II-m,-c[9],INSERT_VALUES);CHKERRQ(ierr); }
if (i<m-1) { ierr = MatSetValue(A[4],II,II+m,-c[9],INSERT_VALUES);CHKERRQ(ierr); }
}
/* assemble matrices */
for (i=0;i<NMAT;i++) {
ierr = MatAssemblyBegin(A[i],MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
for (i=0;i<NMAT;i++) {
ierr = MatAssemblyEnd(A[i],MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and solve the problem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PEPCreate(PETSC_COMM_WORLD,&pep);CHKERRQ(ierr);
ierr = PEPSetOperators(pep,NMAT,A);CHKERRQ(ierr);
ierr = PEPSetFromOptions(pep);CHKERRQ(ierr);
ierr = PEPSolve(pep);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PEPPrintSolution(pep,NULL);CHKERRQ(ierr);
ierr = PEPDestroy(&pep);CHKERRQ(ierr);
for (i=0;i<NMAT;i++) {
ierr = MatDestroy(&A[i]);CHKERRQ(ierr);
}
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
void
NRSolver :: applyConstraintsToStiffness(SparseMtrx *k)
{
if ( this->smConstraintVersion == k->giveVersion() ) {
return;
}
#if 0
#ifdef __PETSC_MODULE
if ( solverType == ST_Petsc ) {
PetscScalar diagVal = 1.0;
if ( k->giveType() != SMT_PetscMtrx ) {
OOFEM_ERROR("NRSolver :: applyConstraintsToStiffness: PetscSparseMtrx Expected");
}
PetscSparseMtrx *lhs = ( PetscSparseMtrx * ) k;
if ( !prescribedEgsIS_defined ) {
IntArray eqs;
#ifdef __PARALLEL_MODE
Natural2GlobalOrdering *n2lpm = engngModel->givePetscContext(1)->giveN2Gmap();
int s = prescribedEqs.giveSize();
eqs.resize(s);
for ( int i = 1; i <= s; i++ ) {
eqs.at(i) = n2lpm->giveNewEq( prescribedEqs.at(i) );
}
ISCreateGeneral(PETSC_COMM_WORLD, s, eqs.givePointer(), & prescribedEgsIS);
//ISView(prescribedEgsIS,PETSC_VIEWER_STDOUT_WORLD);
#else
eqs.resize(numberOfPrescribedDofs);
for ( int i = 1; i <= numberOfPrescribedDofs; i++ ) {
eqs.at(i) = prescribedEqs.at(i) - 1;
}
ISCreateGeneral(PETSC_COMM_SELF, numberOfPrescribedDofs, eqs.givePointer(), & prescribedEgsIS);
//ISView(prescribedEgsIS,PETSC_VIEWER_STDOUT_SELF);
#endif
prescribedEgsIS_defined = true;
}
//MatView(*(lhs->giveMtrx()),PETSC_VIEWER_STDOUT_WORLD);
MatZeroRows(* ( lhs->giveMtrx() ), prescribedEgsIS, & diagVal);
//MatView(*(lhs->giveMtrx()),PETSC_VIEWER_STDOUT_WORLD);
if ( numberOfPrescribedDofs ) {
this->smConstraintVersion = k->giveVersion();
}
return;
}
#endif // __PETSC_MODULE
#else
#ifdef __PETSC_MODULE
if ( solverType == ST_Petsc ) {
if ( k->giveType() != SMT_PetscMtrx ) {
OOFEM_ERROR("NRSolver :: applyConstraintsToStiffness: PetscSparseMtrx Expected");
}
PetscSparseMtrx *lhs = ( PetscSparseMtrx * ) k;
Vec diag;
PetscScalar *ptr;
int eq;
PetscContext *parallel_context = engngModel->givePetscContext(this->domain->giveNumber());
parallel_context->createVecGlobal(& diag);
MatGetDiagonal(* lhs->giveMtrx(), diag);
VecGetArray(diag, & ptr);
for ( int i = 1; i <= numberOfPrescribedDofs; i++ ) {
eq = prescribedEqs.at(i) - 1;
MatSetValue(* ( lhs->giveMtrx() ), eq, eq, ptr [ eq ] * 1.e6, INSERT_VALUES);
}
MatAssemblyBegin(* lhs->giveMtrx(), MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(* lhs->giveMtrx(), MAT_FINAL_ASSEMBLY);
VecRestoreArray(diag, & ptr);
VecDestroy(&diag);
if ( numberOfPrescribedDofs ) {
this->smConstraintVersion = k->giveVersion();
}
return;
}
#endif // __PETSC_MODULE
#endif
for ( int i = 1; i <= numberOfPrescribedDofs; i++ ) {
k->at( prescribedEqs.at(i), prescribedEqs.at(i) ) *= 1.e6;
}
if ( numberOfPrescribedDofs ) {
this->smConstraintVersion = k->giveVersion();
}
}
