int main(int argc,char **argv) {
SNES snes; Vec x,f; Mat J; DA da;
PetscInitialize(&argc,&argv,(char *)0,help);
DACreate1d(PETSC_COMM_WORLD,DA_NONPERIODIC,8,1,1,PETSC_NULL,&da);
DACreateGlobalVector(da,&x); VecDuplicate(x,&f);
DAGetMatrix(da,MATAIJ,&J);
SNESCreate(PETSC_COMM_WORLD,&snes);
SNESSetFunction(snes,f,ComputeFunction,da);
SNESSetJacobian(snes,J,J,ComputeJacobian,da);
SNESSetFromOptions(snes);
SNESSolve(snes,PETSC_NULL,x);
MatDestroy(J); VecDestroy(x); VecDestroy(f); SNESDestroy(snes); DADestroy(da);
PetscFinalize();
return 0;}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
KSP ksp;
PC pc;
Vec x,b;
DA da;
Mat A,Atrans;
PetscInt dof=1,M=-8;
PetscTruth flg,trans=PETSC_FALSE;
PetscInitialize(&argc,&argv,(char *)0,help);
ierr = PetscOptionsGetInt(PETSC_NULL,"-dof",&dof,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-M",&M,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetTruth(PETSC_NULL,"-trans",&trans,PETSC_NULL);CHKERRQ(ierr);
ierr = DACreate(PETSC_COMM_WORLD,&da);CHKERRQ(ierr);
ierr = DASetDim(da,3);CHKERRQ(ierr);
ierr = DASetPeriodicity(da,DA_NONPERIODIC);CHKERRQ(ierr);
ierr = DASetStencilType(da,DA_STENCIL_STAR);CHKERRQ(ierr);
ierr = DASetSizes(da,M,M,M);CHKERRQ(ierr);
ierr = DASetNumProcs(da,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
ierr = DASetDof(da,dof);CHKERRQ(ierr);
ierr = DASetStencilWidth(da,1);CHKERRQ(ierr);
ierr = DASetVertexDivision(da,PETSC_NULL,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
ierr = DASetFromOptions(da);CHKERRQ(ierr);
ierr = DACreateGlobalVector(da,&x);CHKERRQ(ierr);
ierr = DACreateGlobalVector(da,&b);CHKERRQ(ierr);
ierr = ComputeRHS(da,b);CHKERRQ(ierr);
ierr = DAGetMatrix(da,MATBAIJ,&A);CHKERRQ(ierr);
ierr = ComputeMatrix(da,A);CHKERRQ(ierr);
/* A is non-symmetric. Make A = 0.5*(A + Atrans) symmetric for testing icc and cholesky */
ierr = MatTranspose(A,MAT_INITIAL_MATRIX,&Atrans);CHKERRQ(ierr);
ierr = MatAXPY(A,1.0,Atrans,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatScale(A,0.5);CHKERRQ(ierr);
ierr = MatDestroy(Atrans);CHKERRQ(ierr);
/* Test sbaij matrix */
flg = PETSC_FALSE;
ierr = PetscOptionsGetTruth(PETSC_NULL, "-test_sbaij1", &flg,PETSC_NULL);CHKERRQ(ierr);
if (flg){
Mat sA;
ierr = MatConvert(A,MATSBAIJ,MAT_INITIAL_MATRIX,&sA);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
A = sA;
}
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,A,A,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetDA(pc,da);CHKERRQ(ierr);
if (trans) {
ierr = KSPSolveTranspose(ksp,b,x);CHKERRQ(ierr);
} else {
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
}
/* check final residual */
flg = PETSC_FALSE;
ierr = PetscOptionsGetTruth(PETSC_NULL, "-check_final_residual", &flg,PETSC_NULL);CHKERRQ(ierr);
if (flg){
Vec b1;
PetscReal norm;
ierr = KSPGetSolution(ksp,&x);CHKERRQ(ierr);
ierr = VecDuplicate(b,&b1);CHKERRQ(ierr);
ierr = MatMult(A,x,b1);CHKERRQ(ierr);
ierr = VecAXPY(b1,-1.0,b);CHKERRQ(ierr);
ierr = VecNorm(b1,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Final residual %g\n",norm);CHKERRQ(ierr);
ierr = VecDestroy(b1);CHKERRQ(ierr);
}
ierr = KSPDestroy(ksp);CHKERRQ(ierr);
ierr = VecDestroy(x);CHKERRQ(ierr);
ierr = VecDestroy(b);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = DADestroy(da);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
SNES snes; /* nonlinear solver */
Vec Hu,r; /* solution, residual vectors */
Mat J; /* Jacobian matrix */
AppCtx user; /* user-defined work context */
PetscInt its, i, tmpxs, tmpxm; /* iteration count, index, etc. */
PetscReal tmp1, tmp2, tmp3, tmp4, tmp5,
errnorms[2], descaleNode[2];
PetscTruth eps_set = PETSC_FALSE, dump = PETSC_FALSE, exactinitial = PETSC_FALSE,
snes_mf_set, snes_fd_set;
MatFDColoring matfdcoloring = 0;
ISColoring iscoloring;
SNESConvergedReason reason; /* Check convergence */
PetscInitialize(&argc,&argv,(char *)0,help);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD, &user.rank); CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,
"BODVARDSSON solves for thickness and velocity in 1D, steady ice stream\n"
" [run with -help for info and options]\n");CHKERRQ(ierr);
user.n = 3.0; /* Glen flow law exponent */
user.secpera = 31556926.0;
user.rho = 910.0; /* kg m^-3 */
user.rhow = 1028.0; /* kg m^-3 */
user.g = 9.81; /* m s^-2 */
/* ask Test N for its parameters, but only those we need to solve */
ierr = params_exactN(&(user.H0), &tmp1, &(user.xc), &tmp2, &tmp3, &tmp4, &tmp5,
&(user.Txc)); CHKERRQ(ierr);
/* regularize using strain rate of 1/xc per year */
user.epsilon = (1.0 / user.secpera) / user.xc;
/* tools for non-dimensionalizing to improve equation scaling */
user.scaleNode[0] = 1000.0; user.scaleNode[1] = 100.0 / user.secpera;
ierr = PetscOptionsTruth("-snes_mf","","",PETSC_FALSE,&snes_mf_set,NULL);CHKERRQ(ierr);
ierr = PetscOptionsTruth("-snes_fd","","",PETSC_FALSE,&snes_fd_set,NULL);CHKERRQ(ierr);
if (!snes_mf_set && !snes_fd_set) {
PetscPrintf(PETSC_COMM_WORLD,
"\n***ERROR: bodvardsson needs one or zero of '-snes_mf', '-snes_fd'***\n\n"
"USAGE FOLLOWS ...\n\n%s",help);
PetscEnd();
}
if (snes_fd_set) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
" using approximate Jacobian; finite-differencing using coloring\n");
CHKERRQ(ierr);
} else if (snes_mf_set) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
" matrix free; no preconditioner\n"); CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_WORLD,
" true Jacobian\n"); CHKERRQ(ierr);
}
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,
"bodvardsson program options",__FILE__);CHKERRQ(ierr);
{
ierr = PetscOptionsTruth("-bod_up_one","","",PETSC_FALSE,&user.upwind1,NULL);CHKERRQ(ierr);
ierr = PetscOptionsTruth("-bod_exact_init","","",PETSC_FALSE,&exactinitial,NULL);CHKERRQ(ierr);
ierr = PetscOptionsTruth("-bod_dump",
"dump out exact and approximate solution and residual, as asci","",
dump,&dump,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-bod_epsilon","regularization (a strain rate in units of 1/a)","",
user.epsilon * user.secpera,&user.epsilon,&eps_set);CHKERRQ(ierr);
if (eps_set) user.epsilon *= 1.0 / user.secpera;
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* Create machinery for parallel grid management (DA), nonlinear solver (SNES),
and Vecs for fields (solution, RHS). Note default Mx=46 grid points means
dx=10 km. Also degrees of freedom = 2 (thickness and velocity
at each point) and stencil radius = ghost width = 2 for 2nd-order upwinding. */
user.solnghostwidth = 2;
ierr = DACreate1d(PETSC_COMM_WORLD,DA_NONPERIODIC,-46,2,user.solnghostwidth,PETSC_NULL,&user.da);
CHKERRQ(ierr);
ierr = DASetUniformCoordinates(user.da,0.0,user.xc,
PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
ierr = DASetFieldName(user.da,0,"ice thickness [non-dimensional]"); CHKERRQ(ierr);
ierr = DASetFieldName(user.da,1,"ice velocity [non-dimensional]"); CHKERRQ(ierr);
ierr = DAGetInfo(user.da,PETSC_IGNORE,&user.Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
ierr = DAGetCorners(user.da,&user.xs,PETSC_NULL,PETSC_NULL,&user.xm,PETSC_NULL,PETSC_NULL);
CHKERRQ(ierr);
user.dx = user.xc / (PetscReal)(user.Mx-1);
/* another DA for scalar parameters, with same length */
ierr = DACreate1d(PETSC_COMM_WORLD,DA_NONPERIODIC,user.Mx,1,1,PETSC_NULL,&user.scalarda);CHKERRQ(ierr);
ierr = DASetUniformCoordinates(user.scalarda,0.0,user.xc,
PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
/* check that parallel layout of scalar DA is same as dof=2 DA */
ierr = DAGetCorners(user.scalarda,&tmpxs,PETSC_NULL,PETSC_NULL,&tmpxm,PETSC_NULL,PETSC_NULL);
CHKERRQ(ierr);
if ((tmpxs != user.xs) || (tmpxm != user.xm)) {
PetscPrintf(PETSC_COMM_SELF,
"\n***ERROR: rank %d gets different ownership range for the two DAs! ENDING ...***\n\n",
user.rank);
PetscEnd();
}
ierr = PetscPrintf(PETSC_COMM_WORLD,
" Mx = %D points, dx = %.3f m\n H0 = %.2f m, xc = %.2f km, Txc = %.5e Pa m\n",
user.Mx, user.dx, user.H0, user.xc/1000.0, user.Txc);CHKERRQ(ierr);
/* Extract/allocate global vectors from DAs and duplicate for remaining same types */
ierr = DACreateGlobalVector(user.da,&Hu);CHKERRQ(ierr);
ierr = VecSetBlockSize(Hu,2);CHKERRQ(ierr);
ierr = VecDuplicate(Hu,&r);CHKERRQ(ierr); /* inherits block size */
ierr = VecDuplicate(Hu,&user.Huexact);CHKERRQ(ierr); /* ditto */
ierr = DACreateGlobalVector(user.scalarda,&user.M);CHKERRQ(ierr);
ierr = VecDuplicate(user.M,&user.Bstag);CHKERRQ(ierr);
ierr = VecDuplicate(user.M,&user.beta);CHKERRQ(ierr);
ierr = DASetLocalFunction(user.da,(DALocalFunction1)scshell);CHKERRQ(ierr);
ierr = DASetLocalJacobian(user.da,(DALocalFunction1)BodJacobianMatrixLocal);CHKERRQ(ierr);
ierr = SNESCreate(PETSC_COMM_WORLD,&snes);CHKERRQ(ierr);
ierr = SNESSetFunction(snes,r,SNESDAFormFunction,&user);CHKERRQ(ierr);
/* setting up a matrix is only actually needed for -snes_fd case */
ierr = DAGetMatrix(user.da,MATAIJ,&J);CHKERRQ(ierr);
if (snes_fd_set) {
/* tools needed so DA can use sparse matrix for its F.D. Jacobian approx */
ierr = DAGetColoring(user.da,IS_COLORING_GLOBAL,MATAIJ,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(matfdcoloring,
(PetscErrorCode (*)(void))SNESDAFormFunction,&user);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESDefaultComputeJacobianColor,matfdcoloring);CHKERRQ(ierr);
} else {
ierr = SNESSetJacobian(snes,J,J,SNESDAComputeJacobian,&user);CHKERRQ(ierr);
}
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
/* the the Bodvardsson (1955) exact solution allows setting M(x), B(x), beta(x), T(xc) */
ierr = FillDistributedParams(&user);CHKERRQ(ierr);
/* the exact thickness and exact ice velocity (user.uHexact) are known from Bodvardsson (1955) */
ierr = FillExactSoln(&user); CHKERRQ(ierr);
if (exactinitial) {
ierr = PetscPrintf(PETSC_COMM_WORLD," using exact solution as initial guess\n");
CHKERRQ(ierr);
/* the initial guess is the exact continuum solution */
ierr = VecCopy(user.Huexact,Hu); CHKERRQ(ierr);
} else {
ierr = FillInitial(&user, &Hu); CHKERRQ(ierr);
}
/************ SOLVE NONLINEAR SYSTEM ************/
/* recall that RHS r is used internally by KSP, and is set by the SNES */
for (i = 0; i < 2; i++) descaleNode[i] = 1.0 / user.scaleNode[i];
ierr = VecStrideScaleAll(Hu,descaleNode); CHKERRQ(ierr); /* de-dimensionalize initial guess */
ierr = SNESSolve(snes,PETSC_NULL,Hu);CHKERRQ(ierr);
ierr = VecStrideScaleAll(Hu,user.scaleNode); CHKERRQ(ierr); /* put back in "real" scale */
ierr = SNESGetIterationNumber(snes,&its);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(snes,&reason);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,
" %s Number of Newton iterations = %D\n",
SNESConvergedReasons[reason],its);CHKERRQ(ierr);
if (dump) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
" viewing combined result Hu\n");CHKERRQ(ierr);
ierr = VecView(Hu,PETSC_VIEWER_STDOUT_WORLD); CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,
" viewing combined exact result Huexact\n");CHKERRQ(ierr);
ierr = VecView(user.Huexact,PETSC_VIEWER_STDOUT_WORLD); CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,
" viewing final combined residual at Hu\n");CHKERRQ(ierr);
ierr = VecView(r,PETSC_VIEWER_STDOUT_WORLD); CHKERRQ(ierr);
}
/* evaluate error relative to exact solution */
ierr = VecAXPY(Hu,-1.0,user.Huexact); CHKERRQ(ierr); /* Hu = - Huexact + Hu */
ierr = VecStrideNormAll(Hu,NORM_INFINITY,errnorms); CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,
"(dx,errHinf,erruinf) %.3f %.4e %.4e\n",
user.dx,errnorms[0],errnorms[1]*user.secpera);CHKERRQ(ierr);
ierr = VecDestroy(Hu);CHKERRQ(ierr);
ierr = VecDestroy(r);CHKERRQ(ierr);
ierr = VecDestroy(user.Huexact);CHKERRQ(ierr);
ierr = VecDestroy(user.M);CHKERRQ(ierr);
ierr = VecDestroy(user.Bstag);CHKERRQ(ierr);
ierr = VecDestroy(user.beta);CHKERRQ(ierr);
ierr = MatDestroy(J); CHKERRQ(ierr);
ierr = SNESDestroy(snes);CHKERRQ(ierr);
ierr = DADestroy(user.da);CHKERRQ(ierr);
ierr = DADestroy(user.scalarda);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
END_TEST
START_TEST( test_Grid3D )
{
PetscErrorCode ierr;
int i,j,k,c=0;
int d1=3,d2=4,d3=5;
Grid3D g;
ierr = Grid3DCreate("test",d1,d2,d3,&g); CHKERRQ(ierr);
for (i = 0; i < g->len; ++i)
{
g->v1[i] = i;
}
DA da;
ierr = DACreate3d(PETSC_COMM_SELF,//MPI Communicator
DA_NONPERIODIC, //DA_NONPERIODIC, DA_XPERIODIC, DA_YPERIODIC, DA_XYPERIODIC
DA_STENCIL_STAR, //DA_STENCIL_BOX or DA_STENCIL_STAR
d1, d2, d3, //Global dimension
1, 1, 1, //Number procs per dim
1, //dof
1, //stencil width
0,0,0, //specific array of nodes
&da);
Mat m;
ierr = DAGetMatrix( da, MATSEQAIJ, &m); CHKERRQ(ierr);
PetscReal val=0;
MatStencil row;row.c=0;
for (row.k = 0; row.k < g->d3; ++row.k)
{
for (row.j = 0; row.j < g->d2; ++row.j)
{
for (row.i = 0; row.i < g->d1; ++row.i)
{
ierr = MatSetValuesStencil(m, 1, &row, 1, &row, &val,INSERT_VALUES); CHKERRQ(ierr);
val++;
}
}
}
MatAssemblyBegin(m,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(m,MAT_FINAL_ASSEMBLY);
// MatView(m, PETSC_VIEWER_STDOUT_SELF);
Grid3D diag;
Grid3DCreate("diag",d1,d2,d3,&diag);
MatGetDiagonal(m, diag->v);
// VecView(diag->v, PETSC_VIEWER_STDOUT_SELF);
c=0;
for (i = 0; i < g->d1; ++i)
{
for (j = 0; j < g->d2; ++j)
{
for (k = 0; k < g->d3; ++k)
{
fail_unless(g->v3[i][j][k] == g->v1[c], "triple index failed: %f != %f at (%d, %d, %d) or %d\n", g->v3[i][j][k], g->v1[c], i,j,k,c);
val = g->v1[From3Dto1D(g,i,j,k)];
fail_unless(val == g->v1[c], "single index failed: %f != %f at (%d, %d, %d) or %d\n", val, g->v1[c], i,j,k,c);
fail_unless(val == diag->v1[c], "single index failed: %f != %f at (%d, %d, %d) or %d\n", val, diag->v1[c], i,j,k,c);
c++;
}
}
}
WriteVecToDisk(g->wv);
ierr = Grid3DDestroy(g); CHKERRQ(ierr);
}
int main(int argc,char **args)
{
Vec u;
Mat A;
PetscErrorCode ierr;
mv_MultiVectorPtr eigenvectors;
PetscScalar * eigs;
PetscScalar * eigs_hist;
double * resid;
double * resid_hist;
int iterations;
PetscMPIInt rank;
int n_eigs = 1;
int seed = 1;
int i,j;
PetscLogDouble t1,t2,elapsed_time;
DA da;
double tol=1e-08;
PetscTruth option_present;
PetscTruth freepart=PETSC_FALSE;
PetscTruth full_output=PETSC_FALSE;
PetscInt m,n,p;
KSP ksp;
lobpcg_Tolerance lobpcg_tol;
int maxIt = 100;
mv_InterfaceInterpreter ii;
lobpcg_BLASLAPACKFunctions blap_fn;
aux_data_struct aux_data;
/*
PetscViewer viewer;
*/
PetscInt tmp_int;
mv_TempMultiVector * xe;
PetscInt N;
PetscScalar * xx;
PetscInitialize(&argc,&args,(char *)0,help);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n_eigs",&tmp_int,&option_present);CHKERRQ(ierr);
if (option_present)
n_eigs = tmp_int;
ierr = PetscOptionsGetReal(PETSC_NULL,"-tol", &tol,PETSC_NULL); CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL,"-freepart",&freepart); CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL,"-full_out",&full_output); CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-seed",&tmp_int,&option_present);CHKERRQ(ierr);
if (option_present)
seed = tmp_int;
ierr = PetscOptionsGetInt(PETSC_NULL,"-itr",&tmp_int,&option_present);CHKERRQ(ierr);
if (option_present)
maxIt = tmp_int;
if (seed<1)
seed=1;
/* we actually run our code twice: first time we solve small problem just to make sure
that all program code is actually loaded into memory; then we solve the problem
we are interested in; this trick is done for accurate timing
*/
PreLoadBegin(PETSC_TRUE,"grid and matrix assembly");
/* "create" the grid and stencil data; on first run we form small problem */
if (PreLoadIt==0)
{
/* small problem */
ierr=DACreate3d(PETSC_COMM_WORLD,DA_NONPERIODIC,DA_STENCIL_STAR,10,10,10,
1,PETSC_DECIDE,1,1,1,0,0,0,&da); CHKERRQ(ierr);
}
else
{
/* actual problem */
if (freepart) /* petsc determines partitioning */
{
ierr=DACreate3d(PETSC_COMM_WORLD,DA_NONPERIODIC,DA_STENCIL_STAR,-10,-10,-10,
PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,1,1,0,0,0,&da); CHKERRQ(ierr);
}
else /* (1,NP,1) partitioning */
{
ierr=DACreate3d(PETSC_COMM_WORLD,DA_NONPERIODIC,DA_STENCIL_STAR,-10,-10,-10,
1,PETSC_DECIDE,1,1,1,0,0,0,&da); CHKERRQ(ierr);
}
/* now we print what partitioning is chosen */
ierr=DAGetInfo(da,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL,&m,
&n,&p,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL); CHKERRQ(ierr);
PetscPrintf(PETSC_COMM_WORLD,"Partitioning: %u %u %u\n",m,n,p);
}
/* create matrix, whose nonzero structure and probably partitioning corresponds to
grid and stencil structure */
ierr=DAGetMatrix(da,MATMPIAIJ,&A); CHKERRQ(ierr);
/* fill the matrix with values. I intend to build 7-pt Laplas */
/* this procedure includes matrix assembly */
ierr=FillMatrix(da,A); CHKERRQ(ierr);
/*
PetscViewerBinaryOpen(PETSC_COMM_WORLD,"matrix.dat",FILE_MODE_WRITE,&viewer);
MatView(A,PETSC_VIEWER_STDOUT_WORLD);
PetscViewerDestroy(viewer);
*/
/*
Create parallel vectors.
- We form 1 vector from scratch and then duplicate as needed.
*/
ierr = DACreateGlobalVector(da,&u); CHKERRQ(ierr);
/* ierr = VecSetFromOptions(u);CHKERRQ(ierr); */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the linear solver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Here we START measuring time for preconditioner setup */
PreLoadStage("preconditioner setup");
ierr = PetscGetTime(&t1);CHKERRQ(ierr);
/*
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,DIFFERENT_NONZERO_PATTERN);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);
/* probably this call actually builds the preconditioner */
ierr = KSPSetUp(ksp);CHKERRQ(ierr);
/* Here we STOP measuring time for preconditioner setup */
PreLoadStage("solution");
ierr = PetscGetTime(&t2);CHKERRQ(ierr);
elapsed_time=t2-t1;
if (PreLoadIt==1)
PetscPrintf(PETSC_COMM_WORLD,"Preconditioner setup, seconds: %f\n",elapsed_time);
/* request memory for eig-vals */
ierr = PetscMalloc(sizeof(PetscScalar)*n_eigs,&eigs); CHKERRQ(ierr);
/* request memory for eig-vals history */
ierr = PetscMalloc(sizeof(PetscScalar)*n_eigs*(maxIt+1),&eigs_hist); CHKERRQ(ierr);
/* request memory for resid. norms */
ierr = PetscMalloc(sizeof(double)*n_eigs,&resid); CHKERRQ(ierr);
/* request memory for resid. norms hist. */
ierr = PetscMalloc(sizeof(double)*n_eigs*(maxIt+1),&resid_hist); CHKERRQ(ierr);
LOBPCG_InitRandomContext();
MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
PETSCSetupInterpreter( &ii );
eigenvectors = mv_MultiVectorCreateFromSampleVector(&ii, n_eigs,u);
xe = (mv_TempMultiVector *) mv_MultiVectorGetData( eigenvectors );
/*
VecView( (Vec)xe->vector[0],PETSC_VIEWER_STDOUT_WORLD);
*/
for (i=0; i<seed; i++) /* this cycle is to imitate changing random seed */
mv_MultiVectorSetRandom (eigenvectors, 1234);
/*
VecView( (Vec)xe->vector[0],PETSC_VIEWER_STDOUT_WORLD);
*/
VecGetSize( (Vec)xe->vector[0], &N );
N=mv_TempMultiVectorHeight( xe );
VecGetArray( (Vec)xe->vector[0],&xx);
lobpcg_tol.absolute = tol;
lobpcg_tol.relative = 1e-50;
#ifdef PETSC_USE_COMPLEX
blap_fn.zpotrf = PETSC_zpotrf_interface;
blap_fn.zhegv = PETSC_zsygv_interface;
#else
blap_fn.dpotrf = PETSC_dpotrf_interface;
blap_fn.dsygv = PETSC_dsygv_interface;
#endif
aux_data.A = A;
aux_data.ksp = ksp;
aux_data.ii = ii;
/* Here we START measuring time for solution process */
ierr = PetscGetTime(&t1);CHKERRQ(ierr);
#ifdef PETSC_USE_COMPLEX
lobpcg_solve_complex(
eigenvectors, /*input-initial guess of e-vectors */
&aux_data, /*input-matrix A */
OperatorAMultiVector, /*input-operator A */
NULL, /*input-matrix B */
NULL, /*input-operator B */
&aux_data, /*input-matrix T */
Precond_FnMultiVector, /*input-operator T */
NULL, /*input-matrix Y */
blap_fn, /*input-lapack functions */
lobpcg_tol, /*input-tolerances */
PreLoadIt? maxIt:1, /*input-max iterations */
!rank && PreLoadIt, /*input-verbosity level */
&iterations, /*output-actual iterations */
(komplex *) eigs, /*output-eigenvalues */
(komplex *) eigs_hist, /*output-eigenvalues history */
n_eigs, /*output-history global height */
resid, /*output-residual norms */
resid_hist , /*output-residual norms history */
n_eigs /*output-history global height */
);
#else
lobpcg_solve_double( eigenvectors,
&aux_data,
OperatorAMultiVector,
NULL,
NULL,
&aux_data,
Precond_FnMultiVector,
NULL,
blap_fn,
lobpcg_tol,
PreLoadIt? maxIt:1,
!rank && PreLoadIt,
&iterations,
eigs, /* eigenvalues; "lambda_values" should point to array
containing <blocksize> doubles where <blocksize> is the
width of multivector "blockVectorX" */
eigs_hist,
/* eigenvalues history; a pointer to the entries of the
<blocksize>-by-(<maxIterations>+1) matrix stored in
fortran-style. (i.e. column-wise) The matrix may be
a submatrix of a larger matrix, see next argument */
n_eigs, /* global height of the matrix (stored in fotran-style)
specified by previous argument */
resid,
/* residual norms; argument should point to
array of <blocksize> doubles */
resid_hist ,
/* residual norms history; a pointer to the entries of the
<blocksize>-by-(<maxIterations>+1) matrix stored in
fortran-style. (i.e. column-wise) The matrix may be
a submatrix of a larger matrix, see next argument */
n_eigs
/* global height of the matrix (stored in fotran-style)
specified by previous argument */
);
#endif
/* Here we STOP measuring time for solution process */
ierr = PetscGetTime(&t2);CHKERRQ(ierr);
elapsed_time=t2-t1;
if (PreLoadIt)
PetscPrintf(PETSC_COMM_WORLD,"Solution process, seconds: %e\n",elapsed_time);
if (PreLoadIt && full_output)
{
PetscPrintf(PETSC_COMM_WORLD,"Output from LOBPCG, eigenvalues:\n");
for (i=0;i<n_eigs;i++)
{
ierr = PetscPrintf(PETSC_COMM_WORLD,"%e\n",PetscRealPart(eigs[i]));
CHKERRQ(ierr);
}
PetscPrintf(PETSC_COMM_WORLD,"Output from LOBPCG, eigenvalues history:\n");
for (j=0; j<iterations+1; j++)
for (i=0;i<n_eigs;i++)
{
ierr = PetscPrintf(PETSC_COMM_WORLD,"%e\n",PetscRealPart(*(eigs_hist+j*n_eigs+i)));
CHKERRQ(ierr);
}
PetscPrintf(PETSC_COMM_WORLD,"Output from LOBPCG, residual norms:\n");
for (i=0;i<n_eigs;i++)
{
ierr = PetscPrintf(PETSC_COMM_WORLD,"%e\n",resid[i]);
CHKERRQ(ierr);
}
PetscPrintf(PETSC_COMM_WORLD,"Output from LOBPCG, residual norms history:\n");
for (j=0; j<iterations+1; j++)
for (i=0;i<n_eigs;i++)
{
ierr = PetscPrintf(PETSC_COMM_WORLD,"%e\n",*(resid_hist+j*n_eigs+i));
CHKERRQ(ierr);
}
}
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = VecDestroy(u);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = KSPDestroy(ksp);CHKERRQ(ierr);
ierr = DADestroy(da); CHKERRQ(ierr);
LOBPCG_DestroyRandomContext();
mv_MultiVectorDestroy(eigenvectors);
/* free memory used for eig-vals */
ierr = PetscFree(eigs); CHKERRQ(ierr);
ierr = PetscFree(eigs_hist); CHKERRQ(ierr);
ierr = PetscFree(resid); CHKERRQ(ierr);
ierr = PetscFree(resid_hist); 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).
*/
PreLoadEnd();
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **args)
{
PetscErrorCode ierr;
PetscInitialize(&argc,&args,(char *)0,help);
PetscInt m = 10; /* default number of rows and columns IN GRID,
but matrix is (m^2) x (m^2) */
ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr);
MPI_Comm com = PETSC_COMM_WORLD;
PetscMPIInt rank, size;
ierr = MPI_Comm_rank(com, &rank); CHKERRQ(ierr);
ierr = MPI_Comm_size(com, &size); CHKERRQ(ierr);
/* create m x m two-dimensional grid for periodic boundary condition problem */
DA da2;
PetscInt dof=1, stencilwidth=1;
ierr = DACreate2d(com, DA_XYPERIODIC, DA_STENCIL_STAR,
m,m,PETSC_DECIDE,PETSC_DECIDE,
dof,stencilwidth,PETSC_NULL,PETSC_NULL,&da2); CHKERRQ(ierr);
/* get da2-managed Vecs */
Vec x,b,u;
ierr = DACreateGlobalVector(da2,&x); CHKERRQ(ierr);
ierr = VecDuplicate(x,&b); CHKERRQ(ierr);
ierr = VecDuplicate(x,&u); CHKERRQ(ierr);
Mat A;
ierr = DAGetMatrix(da2, MATMPIAIJ, &A); CHKERRQ(ierr);
/* alternative call below is not quite same as result from DAGetMatrix(),
because of nonzero allocation; the Mat ownership ranges are same */
/* ierr = MatCreateMPIAIJ(com, mlocal, mlocal, m*m, m*m,
5, PETSC_NULL, 4, PETSC_NULL,
&A); CHKERRQ(ierr) */
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
/* report on ownership range */
PetscInt rstart,rend,mlocal;
ierr = VecGetOwnershipRange(x,&rstart,&rend);CHKERRQ(ierr);
ierr = VecGetLocalSize(x,&mlocal);CHKERRQ(ierr);
PetscInt A_rstart,A_rend;
ierr = MatGetOwnershipRange(A,&A_rstart,&A_rend);CHKERRQ(ierr);
if ((rstart != A_rstart) || (rend != A_rend)) {
ierr = PetscPrintf(com,
"Vec and Mat ownership ranges different!!! ending ...\n"); CHKERRQ(ierr);
PetscEnd();
} else {
ierr = PetscSynchronizedPrintf(com,
"rank=%d has Vec and Mat ownership: mlocal=%d, rstart=%d, rend=%d\n",
rank,mlocal,rstart,rend); CHKERRQ(ierr);
}
PetscSynchronizedFlush(com);
/* get local part of grid */
PetscInt xm,ym,xs,ys;
DAGetCorners(da2,&xs,&ys,0,&xm,&ym,0);
/* report on local part of grid */
ierr = PetscSynchronizedPrintf(com,
"rank=%d has da2-managed-Vec local ranges: xs=%d, xm=%d, ys=%d, ym=%d\n",
rank,xs,xm,ys,ym); CHKERRQ(ierr);
PetscSynchronizedFlush(com);
/* set up linear system */
PetscScalar **barr, **uarr; /* RHS and exact soln, resp. */
DAVecGetArray(da2, b, &barr);
DAVecGetArray(da2, u, &uarr);
PetscScalar dx = 1.0/(double)m, dy = dx, pi = 3.14159265358979;
PetscScalar xi,yj;
PetscInt diag=0,north=1,east=2,south=3,west=4;
PetscScalar vals[5] = {-4.0 + dx * dx, 1.0, 1.0, 1.0, 1.0};
MatStencil row, col[5]; /* these are not "stencils" at all, but local grid
to global indices helpers */
PetscInt i,j,num;
for (j=ys; j<ys+ym; j++) {
for(i=xs; i<xs+xm; i++) {
/* entries of matrix A */
row.i = i; row.j = j; row.c = 0; /* dof = 1 so first component;
note row.k is for 3d DAs */
for (num=0; num<5; num++) col[num].c = 0;
/* set diag first, then go through stencil neighbors */
col[diag].i = i; col[diag].j = j;
col[north].i = i; col[north].j = j+1;
col[east].i = i+1; col[east].j = j;
col[south].i = i; col[south].j = j-1;
col[west].i = i-1; col[west].j = j;
ierr = MatSetValuesStencil(A,1,&row,5,col,vals,INSERT_VALUES); CHKERRQ(ierr);
/* entries of vectors: exact solution u and right-hand-side b */
xi = (double)i * dx;
yj = (double)j * dy;
uarr[j][i] = sin(2.0 * pi * xi) * cos(4.0 * pi * yj);
barr[j][i] = (1.0 - 20.0 * pi * pi) * uarr[j][i];
barr[j][i] *= dx * dx;
}
}
DAVecRestoreArray(da2, b, &barr);
DAVecRestoreArray(da2, u, &uarr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
ierr = VecAssemblyBegin(b); CHKERRQ(ierr);
ierr = VecAssemblyEnd(b); CHKERRQ(ierr);
ierr = VecAssemblyBegin(u); CHKERRQ(ierr);
ierr = VecAssemblyEnd(u); CHKERRQ(ierr);
/* uncomment for dense view; -mat_view default format is good enough for most purposes
PetscViewer viewer;
PetscViewerCreate(com, &viewer);
PetscViewerSetType(viewer, PETSC_VIEWER_ASCII);
PetscViewerSetFormat(viewer, PETSC_VIEWER_ASCII_DENSE);
MatView(A,viewer);
PetscViewerDestroy(viewer);
*/
/* setup solver context now that Mat and Vec are assembled */
KSP ksp;
ierr = KSPCreate(com,&ksp);CHKERRQ(ierr);
/* Set "operators". Here the matrix that defines the linear system
also serves as the preconditioning matrix. But we do not assert a
relationship between their nonzero patterns.(???) */
ierr = KSPSetOperators(ksp,A,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
/* Following is optional; parameters could be set at runtime. */
ierr = KSPSetTolerances(ksp,1.e-7,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);
CHKERRQ(ierr);
/* Set runtime options, e.g.,
-ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
*/
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
/* Solve linear system */
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
/* Compute and report the error (and the iteration count and reason). */
PetscScalar norminf, normtwo, neg_one=-1.0;
PetscInt its;
KSPConvergedReason reason;
ierr = VecAXPY(x,neg_one,u);CHKERRQ(ierr); // x = x - u
ierr = VecNorm(x,NORM_INFINITY,&norminf);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&normtwo);CHKERRQ(ierr); // discrete norm
normtwo *= dx * dy; // integral norm
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(ksp,&reason); CHKERRQ(ierr);
ierr = PetscPrintf(com,
"Error norms ||err||_inf = %.3e, ||err||_2 = %.3e;\n"
"Iterations = %d; Reason = %d\n",
norminf, normtwo, its, (int) reason);CHKERRQ(ierr);
/* destroy */
ierr = KSPDestroy(ksp);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = VecDestroy(x);CHKERRQ(ierr);
ierr = VecDestroy(u);CHKERRQ(ierr);
ierr = VecDestroy(b);CHKERRQ(ierr);
ierr = DADestroy(da2);CHKERRQ(ierr);
/* Always call PetscFinalize() before exiting a program. */
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
