static PetscErrorCode DMCreateMatrix_Shell(DM dm,Mat *J)
{
PetscErrorCode ierr;
DM_Shell *shell = (DM_Shell*)dm->data;
Mat A;
PetscFunctionBegin;
PetscValidHeaderSpecific(dm,DM_CLASSID,1);
PetscValidPointer(J,3);
if (!shell->A) {
if (shell->Xglobal) {
PetscInt m,M;
ierr = PetscInfo(dm,"Naively creating matrix using global vector distribution without preallocation\n");
CHKERRQ(ierr);
ierr = VecGetSize(shell->Xglobal,&M);
CHKERRQ(ierr);
ierr = VecGetLocalSize(shell->Xglobal,&m);
CHKERRQ(ierr);
ierr = MatCreate(PetscObjectComm((PetscObject)dm),&shell->A);
CHKERRQ(ierr);
ierr = MatSetSizes(shell->A,m,m,M,M);
CHKERRQ(ierr);
ierr = MatSetType(shell->A,dm->mattype);
CHKERRQ(ierr);
ierr = MatSetUp(shell->A);
CHKERRQ(ierr);
} else SETERRQ(PetscObjectComm((PetscObject)dm),PETSC_ERR_USER,"Must call DMShellSetMatrix(), DMShellSetCreateMatrix(), or provide a vector");
}
A = shell->A;
/* the check below is tacky and incomplete */
if (dm->mattype) {
PetscBool flg,aij,seqaij,mpiaij;
ierr = PetscObjectTypeCompare((PetscObject)A,dm->mattype,&flg);
CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&seqaij);
CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)A,MATMPIAIJ,&mpiaij);
CHKERRQ(ierr);
ierr = PetscStrcmp(dm->mattype,MATAIJ,&aij);
CHKERRQ(ierr);
if (!flg) {
if (!(aij && (seqaij || mpiaij))) SETERRQ2(PetscObjectComm((PetscObject)dm),PETSC_ERR_ARG_NOTSAMETYPE,"Requested matrix of type %s, but only %s available",dm->mattype,((PetscObject)A)->type_name);
}
}
if (((PetscObject)A)->refct < 2) { /* We have an exclusive reference so we can give it out */
ierr = PetscObjectReference((PetscObject)A);
CHKERRQ(ierr);
ierr = MatZeroEntries(A);
CHKERRQ(ierr);
*J = A;
} else { /* Need to create a copy, could use MAT_SHARE_NONZERO_PATTERN in most cases */
ierr = MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,J);
CHKERRQ(ierr);
ierr = MatZeroEntries(*J);
CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
void PETScLinearSolver::Initialize( )
{
VecSet(b, 0.0);
VecSet(x, 0.0);
MatZeroEntries(A);
}
void PetscSparseStorage::atPutZeros( int row, int col,
int rowExtent, int colExtent )
{
int m, n;
this->getSize( m, n );
if( 0 == row && 0 == col &&
m == rowExtent && n == colExtent ) {
int ierr;
ierr = MatZeroEntries( M ); assert( ierr == 0);
} else {
double * zeros = new double[colExtent];
double * A = new double[colExtent];
int * jcol = new int [colExtent];
int i, nnz, info;
for ( i = 0; i < colExtent; i++ ) {
zeros[i] = 0.0;
}
for( i = row; i < row + rowExtent; i++ ) {
// Both calls will always succeed.
this->fromGetSpRow( i, col, A, colExtent, jcol, nnz,
colExtent, info );
this->atPutSpRow( i, zeros, nnz, jcol, info );
}
delete [] jcol;
delete [] A;
delete [] zeros;
}
}
static PetscErrorCode RHSJacobianP(TS ts,PetscReal t,Vec X,Mat A,void *ctx0)
{
PetscErrorCode ierr;
PetscScalar a;
PetscInt row,col;
Userctx *ctx=(Userctx*)ctx0;
PetscInt idx=0;
Vec Xgen,Xnet;
PetscScalar *xgen,*xnet;
PetscScalar Eqp,Edp;
PetscScalar Id,Iq;
PetscFunctionBeginUser;
/*if (ctx->jacp_flg) { delete me */
ierr = MatZeroEntries(A);CHKERRQ(ierr);
//recompute since this changes
M[0] = 2*H[0]/w_s; M[1] = 2*H[1]/w_s; M[2] = 2*H[2]/w_s;
D[0] = 0.1*M[0]; D[1] = 0.1*M[1]; D[2] = 0.1*M[2];
ierr = DMCompositeGetLocalVectors(ctx->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(ctx->dmpgrid,X,Xgen,Xnet);CHKERRQ(ierr);
/* Generator subsystem initialization */
ierr = VecGetArray(Xgen,&xgen);CHKERRQ(ierr);
ierr = VecGetArray(Xnet,&xnet);CHKERRQ(ierr);
for (col=0;col<ngen;col++) {
Eqp = xgen[idx];
Edp = xgen[idx+1];
Id = xgen[idx+4];
Iq = xgen[idx+5];
TM[col] = PG[col];
a = -1.0 *(TM[col] - Edp*Id - Eqp*Iq - (Xqp[col]-Xdp[col])*Id*Iq)/M[col]/H[col];
row = 9*col+3; // E is in the 4th equation hence +3
idx = idx + 9; //9 equations per generator, hence move to next gen
ierr = MatSetValues(A,1,&row,1,&col,&a,INSERT_VALUES);CHKERRQ(ierr);
}
/* ctx->jacp_flg = PETSC_FALSE; delete me */
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = VecRestoreArray(Xgen,&xgen);CHKERRQ(ierr);
ierr = VecRestoreArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = DMCompositeGather(ctx->dmpgrid,X,INSERT_VALUES,Xgen,Xnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(ctx->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
//MatView(A,PETSC_VIEWER_STDOUT_SELF);
/* }delete me */
PetscFunctionReturn(0);
}
/*
FormHessian - Evaluates Hessian matrix.
Input Parameters:
. tao - the Tao context
. x - input vector
. ptr - optional user-defined context, as set by TaoSetHessian()
Output Parameters:
. H - Hessian matrix
Note: Providing the Hessian may not be necessary. Only some solvers
require this matrix.
*/
PetscErrorCode FormHessian(Tao tao,Vec X,Mat H, Mat Hpre, void *ptr)
{
AppCtx *user = (AppCtx*)ptr;
PetscErrorCode ierr;
PetscInt i, ind[2];
PetscReal alpha=user->alpha;
PetscReal v[2][2],*x;
PetscBool assembled;
/* Zero existing matrix entries */
ierr = MatAssembled(H,&assembled);CHKERRQ(ierr);
if (assembled){ierr = MatZeroEntries(H); CHKERRQ(ierr);}
/* Get a pointer to vector data */
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
/* Compute H(X) entries */
for (i=0; i<user->n/2; i++){
v[1][1] = 2*alpha;
v[0][0] = -4*alpha*(x[2*i+1]-3*x[2*i]*x[2*i]) + 2;
v[1][0] = v[0][1] = -4.0*alpha*x[2*i];
ind[0]=2*i; ind[1]=2*i+1;
ierr = MatSetValues(H,2,ind,2,ind,v[0],INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
/* Assemble matrix */
ierr = MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscLogFlops(9.0*user->n/2.0);CHKERRQ(ierr);
return 0;
}
double SFieldSolveFor(SField sfv, double *Y, unsigned int yCount) {
mySField sf = static_cast<mySField>(sfv);
assert(yCount <= sf->maxN);
assert(Y);
assert(sf->running);
sf->Y = Y;
sf->curN = yCount;
// -------------- SOLVE
PetscErrorCode ierr;
PetscLogDouble tic,toc;
PetscTime(&tic);
int pt[sf->d];
ierr = MatZeroEntries(sf->J); CHKERRQ(ierr);
JacobianOnD(sf->J, sf->F, 0, pt, sf);
ierr = MatAssemblyBegin(sf->J,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
ierr = MatAssemblyEnd(sf->J,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
PetscTime(&toc);
sf->timeAssembly += toc-tic;
PetscTime(&tic);
ierr = VecZeroEntries(sf->U); CHKERRQ(ierr);
ierr = KSPSetOperators(sf->ksp, sf->J, sf->J); CHKERRQ(ierr);
ierr = KSPSetUp(sf->ksp); CHKERRQ(ierr);
ierr = KSPSolve(sf->ksp,sf->F,sf->U); CHKERRQ(ierr);
PetscTime(&toc);
sf->timeSolver += toc-tic;
return Integrate(sf->U,pt,0,sf);
}
/*@
MatFDColoringApply - Given a matrix for which a MatFDColoring context
has been created, computes the Jacobian for a function via finite differences.
Collective on MatFDColoring
Input Parameters:
+ mat - location to store Jacobian
. coloring - coloring context created with MatFDColoringCreate()
. x1 - location at which Jacobian is to be computed
- sctx - context required by function, if this is being used with the SNES solver then it is SNES object, otherwise it is null
Options Database Keys:
+ -mat_fd_type - "wp" or "ds" (see MATMFFD_WP or MATMFFD_DS)
. -mat_fd_coloring_view - Activates basic viewing or coloring
. -mat_fd_coloring_view draw - Activates drawing of coloring
- -mat_fd_coloring_view ::ascii_info - Activates viewing of coloring info
Level: intermediate
.seealso: MatFDColoringCreate(), MatFDColoringDestroy(), MatFDColoringView(), MatFDColoringSetFunction()
.keywords: coloring, Jacobian, finite differences
@*/
PetscErrorCode MatFDColoringApply(Mat J,MatFDColoring coloring,Vec x1,void *sctx)
{
PetscErrorCode ierr;
PetscBool flg = PETSC_FALSE;
PetscFunctionBegin;
PetscValidHeaderSpecific(J,MAT_CLASSID,1);
PetscValidHeaderSpecific(coloring,MAT_FDCOLORING_CLASSID,2);
PetscValidHeaderSpecific(x1,VEC_CLASSID,3);
if (!coloring->f) SETERRQ(PetscObjectComm((PetscObject)J),PETSC_ERR_ARG_WRONGSTATE,"Must call MatFDColoringSetFunction()");
if (!J->ops->fdcoloringapply) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not supported for this matrix type %s",((PetscObject)J)->type_name);
if (!coloring->setupcalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Must call MatFDColoringSetUp()");
ierr = MatSetUnfactored(J);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,"-mat_fd_coloring_dont_rezero",&flg,NULL);CHKERRQ(ierr);
if (flg) {
ierr = PetscInfo(coloring,"Not calling MatZeroEntries()\n");CHKERRQ(ierr);
} else {
PetscBool assembled;
ierr = MatAssembled(J,&assembled);CHKERRQ(ierr);
if (assembled) {
ierr = MatZeroEntries(J);CHKERRQ(ierr);
}
}
ierr = PetscLogEventBegin(MAT_FDColoringApply,coloring,J,x1,0);CHKERRQ(ierr);
ierr = (*J->ops->fdcoloringapply)(J,coloring,x1,sctx);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_FDColoringApply,coloring,J,x1,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode _RHS_time_dep_ham_p(TS ts,PetscReal t,Vec X,Mat AA,Mat BB,void *ctx){
double time_dep_val;
PetscScalar time_dep_scalar;
int i,j;
operator op;
MatZeroEntries(AA);
MatCopy(full_A,AA,SAME_NONZERO_PATTERN);
for (i=0;i<_num_time_dep;i++){
time_dep_val = _time_dep_list[i].time_dep_func(t);
_add_ops_to_mat_ham(time_dep_val,AA,_time_dep_list[i].num_ops,_time_dep_list[i].ops);
}
for (i=0;i<_num_time_dep_lin;i++){
time_dep_val = _time_dep_list_lin[i].time_dep_func(t);
_add_ops_to_mat_lin(time_dep_val,AA,_time_dep_list_lin[i].num_ops,_time_dep_list_lin[i].ops);
}
MatAssemblyBegin(AA,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(AA,MAT_FINAL_ASSEMBLY);
if(AA!=BB) {
MatAssemblyBegin(AA,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(AA,MAT_FINAL_ASSEMBLY);
}
PetscFunctionReturn(0);
}
/*
FormHessian - Evaluates Hessian matrix.
Input Parameters:
. tao - the Tao context
. x - input vector
. ptr - optional user-defined context, as set by TaoSetHessian()
Output Parameters:
. H - Hessian matrix
Note: Providing the Hessian may not be necessary. Only some solvers
require this matrix.
*/
PetscErrorCode FormHessian(Tao tao,Vec X,Mat H, Mat Hpre, void *ptr)
{
AppCtx *user = (AppCtx*)ptr;
PetscErrorCode ierr;
PetscInt i, ind[2];
PetscReal alpha=user->alpha;
PetscReal v[2][2];
const PetscScalar *x;
PetscBool assembled;
PetscFunctionBeginUser;
/* Zero existing matrix entries */
ierr = MatAssembled(H,&assembled);CHKERRQ(ierr);
if (assembled){ierr = MatZeroEntries(H); CHKERRQ(ierr);}
/* Get a pointer to vector data */
ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
/* Compute H(X) entries */
if (user->chained) {
ierr = MatZeroEntries(H);CHKERRQ(ierr);
for (i=0; i<user->n-1; i++) {
PetscScalar t1 = x[i+1] - x[i]*x[i];
v[0][0] = 2 + 2*alpha*(t1*(-2) - 2*x[i]);
v[0][1] = 2*alpha*(-2*x[i]);
v[1][0] = 2*alpha*(-2*x[i]);
v[1][1] = 2*alpha*t1;
ind[0] = i; ind[1] = i+1;
ierr = MatSetValues(H,2,ind,2,ind,v[0],ADD_VALUES);CHKERRQ(ierr);
}
} else {
for (i=0; i<user->n/2; i++){
v[1][1] = 2*alpha;
v[0][0] = -4*alpha*(x[2*i+1]-3*x[2*i]*x[2*i]) + 2;
v[1][0] = v[0][1] = -4.0*alpha*x[2*i];
ind[0]=2*i; ind[1]=2*i+1;
ierr = MatSetValues(H,2,ind,2,ind,v[0],INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
/* Assemble matrix */
ierr = MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscLogFlops(9.0*user->n/2.0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void PetscSparseStorage::setToDiagonal( OoqpVector& vec_in )
{
int ierr;
PetscVector & vec = dynamic_cast<PetscVector &>(vec_in);
ierr = MatZeroEntries( M ); assert( ierr == 0);
ierr = MatDiagonalSet( M, vec.pv, INSERT_VALUES );
}
PetscErrorCode MatZeroEntries_IS(Mat A)
{
Mat_IS *a = (Mat_IS*)A->data;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MatZeroEntries(a->A);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode DRDPJacobianTranspose(TS ts,PetscReal t,Vec U,Mat DRDP,AppCtx *ctx)
{
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MatZeroEntries(DRDP);CHKERRQ(ierr);
ierr = MatAssemblyBegin(DRDP,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(DRDP,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode FormRHSJacobian(TS ts,PetscReal t,Vec X,Mat Amat,Mat Pmat,void *ptr)
{
User user = (User)ptr;
PetscErrorCode ierr;
const PetscScalar **x;
PetscInt M = user->Nspec+1,i,j,xs,xm;;
DM dm;
PetscFunctionBeginUser;
if (user->reactions) {
ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
ierr = MatZeroEntries(Pmat);CHKERRQ(ierr);
ierr = MatSetOption(Pmat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
ierr = MatSetOption(Pmat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
ierr = DMDAVecGetArrayDOFRead(dm,X,&x);CHKERRQ(ierr);
ierr = DMDAGetCorners(dm,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
for (i=xs; i<xs+xm; i++) {
ierr = PetscMemcpy(user->tchemwork,x[i],(user->Nspec+1)*sizeof(x[xs][0]));CHKERRQ(ierr);
user->tchemwork[0] *= user->Tini; /* Dimensionalize temperature (first row) because that is what Tchem wants */
ierr = TC_getJacTYN(user->tchemwork,user->Nspec,user->Jdense,1);CHKERRQ(ierr);
for (j=0; j<M; j++) user->Jdense[j + 0*M] /= user->Tini; /* Non-dimensionalize first column */
for (j=0; j<M; j++) user->Jdense[0 + j*M] /= user->Tini; /* Non-dimensionalize first row */
for (j=0; j<M; j++) user->rows[j] = i*M+j;
ierr = MatSetValues(Pmat,M,user->rows,M,user->rows,user->Jdense,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = DMDAVecRestoreArrayDOFRead(dm,X,&x);CHKERRQ(ierr);
ierr = MatAssemblyBegin(Pmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(Pmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
} else {
ierr = MatZeroEntries(Pmat);CHKERRQ(ierr);
}
if (user->diffusion) {
ierr = FormDiffusionJacobian(ts,t,X,Amat,Pmat,ptr);CHKERRQ(ierr);
}
if (Amat != Pmat) {
ierr = MatAssemblyBegin(Amat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(Amat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
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
PetscSparseMtrx :: zero()
{
// test if receiver is already assembled
PetscBool assembled;
MatAssembled(this->mtrx, & assembled);
if ( assembled ) {
MatZeroEntries(this->mtrx);
}
this->newValues = true;
}
PetscErrorCode SNESComputeJacobian_MyShell(SNES snes,Vec X,Mat A,Mat B,void *ctx)
{
static PetscInt fail = 0;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = SNESComputeJacobian_DMDA(snes,X,A,B,ctx);CHKERRQ(ierr);
if (fail++ > 0) {
ierr = MatZeroEntries(A);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
Mat mat,submat,*submatrices;
PetscInt m = 10,n = 10,i = 4,tmp;
PetscErrorCode ierr;
IS irkeep,ickeep;
PetscScalar value = 1.0;
PetscViewer sviewer;
PetscInitialize(&argc,&argv,(char *)0,help);
ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_COMMON);CHKERRQ(ierr);
ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_COMMON);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&mat);CHKERRQ(ierr);
ierr = MatSetSizes(mat,PETSC_DECIDE,PETSC_DECIDE,m,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(mat);CHKERRQ(ierr);
for (i=0; i<m; i++) {
value = (PetscReal)i+1; tmp = i % 5;
ierr = MatSetValues(mat,1,&tmp,1,&i,&value,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(PETSC_VIEWER_STDOUT_WORLD,"Original matrix\n");CHKERRQ(ierr);
ierr = MatView(mat,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* Form submatrix with rows 2-4 and columns 4-8 */
ierr = ISCreateStride(PETSC_COMM_SELF,3,2,1,&irkeep);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,5,4,1,&ickeep);CHKERRQ(ierr);
ierr = MatGetSubMatrices(mat,1,&irkeep,&ickeep,MAT_INITIAL_MATRIX,&submatrices);CHKERRQ(ierr);
submat = *submatrices;
ierr = PetscFree(submatrices);CHKERRQ(ierr);
/*
sviewer will cause the submatrices (one per processor) to be printed in the correct order
*/
ierr = PetscViewerASCIIPrintf(PETSC_VIEWER_STDOUT_WORLD,"Submatrices\n");CHKERRQ(ierr);
ierr = PetscViewerGetSingleton(PETSC_VIEWER_STDOUT_WORLD,&sviewer);CHKERRQ(ierr);
ierr = MatView(submat,sviewer);CHKERRQ(ierr);
ierr = PetscViewerRestoreSingleton(PETSC_VIEWER_STDOUT_WORLD,&sviewer);CHKERRQ(ierr);
ierr = PetscViewerFlush(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* Zero the original matrix */
ierr = PetscViewerASCIIPrintf(PETSC_VIEWER_STDOUT_WORLD,"Original zeroed matrix\n");CHKERRQ(ierr);
ierr = MatZeroEntries(mat);CHKERRQ(ierr);
ierr = MatView(mat,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = ISDestroy(&irkeep);CHKERRQ(ierr);
ierr = ISDestroy(&ickeep);CHKERRQ(ierr);
ierr = MatDestroy(&submat);CHKERRQ(ierr);
ierr = MatDestroy(&mat);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
/*
FormIJacobian - Evaluates Jacobian matrix.
Input Parameters:
+ ts - the TS context
. t - pseudo-time
. X - input vector
. Xdot - time derivative
. shift - multiplier for mass matrix
. dummy - user-defined context
Output Parameters:
. J - Jacobian matrix
. B - optionally different preconditioning matrix
. flag - flag indicating matrix structure
*/
static PetscErrorCode FormIJacobian(TS ts,PetscReal t,Vec X,Vec Xdot,PetscReal shift,Mat J,Mat B,void *ictx)
{
const PetscScalar *x;
PetscErrorCode ierr;
PetscInt i;
Ctx *ctx = (Ctx*)ictx;
PetscFunctionBeginUser;
ierr = MatZeroEntries(B);CHKERRQ(ierr);
/*
Get pointer to vector data
*/
ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
/*
Compute Jacobian entries and insert into matrix.
*/
for (i=0; i<ctx->n-1; i++) {
PetscInt rowcol[2];
PetscScalar v[2][2],a,a0,a1,a00,a01,a10,a11;
rowcol[0] = i;
rowcol[1] = i+1;
a = x[i+1] - PetscSqr(x[i]);
a0 = -2.*x[i];
a00 = -2.;
a01 = 0.;
a1 = 1.;
a10 = 0.;
a11 = 0.;
v[0][0] = 2. + 200.*(a*a00 + a0*a0);
v[0][1] = 200.*(a*a01 + a1*a0);
v[1][0] = 200.*(a*a10 + a0*a1);
v[1][1] = 200.*(a*a11 + a1*a1);
ierr = MatSetValues(B,2,rowcol,2,rowcol,&v[0][0],ADD_VALUES);CHKERRQ(ierr);
}
for (i=0; i<ctx->n; i++) {
ierr = MatSetValue(B,i,i,(PetscScalar)shift,ADD_VALUES);CHKERRQ(ierr);
}
ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
/*
Assemble matrix
*/
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (J != B) {
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode FormTangent(TS ts,PetscReal t,Vec U,Vec Udot,PetscReal shift,Mat *A,Mat *B,MatStructure *flag,void *ctx)
{
PetscFunctionBegin;
PetscErrorCode ierr;
SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "FormTangent not implemented, use -snes_mf");
DMDALocalInfo info;
DM da_dof;
Vec localU,localUdot; // local versions
Field **h,**hdot;
/* get the da from the snes */
ierr = TSGetDM(ts,(DM*)&da_dof);CHKERRQ(ierr);
/* handle the vec U */
ierr = DMGetLocalVector(da_dof,&localU);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(da_dof,U,INSERT_VALUES,localU);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da_dof,U,INSERT_VALUES,localU);CHKERRQ(ierr);
/* handle the vec Udot */
ierr = DMGetLocalVector(da_dof,&localUdot);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(da_dof,Udot,INSERT_VALUES,localUdot);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da_dof,Udot,INSERT_VALUES,localUdot);CHKERRQ(ierr);
/* Get the arrays from the vectors */
ierr = DMDAVecGetArray(da_dof,localU,&h);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da_dof,localUdot,&hdot);CHKERRQ(ierr);
/* Grab the local info and call the local tangent routine */
ierr = DMDAGetLocalInfo(da_dof,&info);CHKERRQ(ierr);CHKERRQ(ierr);
ierr = MatZeroEntries(*B);CHKERRQ(ierr); // pre-zero the matrix
ierr = FormTangentLocal(&info,t,h,hdot,shift,B,(AppCtx *) ctx);CHKERRQ(ierr);
ierr = MatAssemblyBegin(*B,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
ierr = MatAssemblyEnd(*B,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
if (*A != *B) { // then we could be matrix free
ierr = MatAssemblyBegin(*A,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
ierr = MatAssemblyEnd(*A,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
}
*flag = SAME_NONZERO_PATTERN; /* the sparsity pattern does not change */
ierr = DMDAVecRestoreArray(da_dof,localUdot,&hdot);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da_dof,localU,&h);CHKERRQ(ierr);
/* Restore the arrays and local vectors */
ierr = DMRestoreLocalVector(da_dof,&localU);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da_dof,&localUdot);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
RawGraph(Mat new_global_mat) {
global_mat = new_global_mat;
//For this code to work, we're going to need the matrix structure for the sequential portion of this matrix.
//Therefore, extract a sequential AIJ matrix.
MatType type;
MatGetType(global_mat, &type);
if (!strcmp(type,MATSEQAIJ)) {
MatDuplicate(global_mat, MAT_DO_NOT_COPY_VALUES, &local_mat);
} else {
MatGetLocalMat(global_mat, MAT_INITIAL_MATRIX, &local_mat);
}
MatZeroEntries(local_mat);
MatGetOwnershipRange(global_mat, &row_begin, &row_end);
//MatView(local_mat, PETSC_VIEWER_DRAW_SELF);
seq_raw.create(local_mat);
}
void linearSystemPETSc<scalar>::zeroMatrix()
{
if (_comm == PETSC_COMM_WORLD){
if (Msg::GetCommSize()>1){
int value = _entriesPreAllocated ? 1 : 0;
int sumValue = 0;
MPI_Allreduce((void*)&value, (void*)&sumValue, 1, MPI_INT, MPI_SUM, _comm);
if ((sumValue >= 0) &&(sumValue < Msg::GetCommSize()) && !_entriesPreAllocated){
preAllocateEntries();
}
}
}
if (_isAllocated && _entriesPreAllocated) {
_assembleMatrixIfNeeded();
_try(MatZeroEntries(_a));
}
}
PetscErrorCode AssembleVelocityMatrix( UserContext *uc )
{
PetscErrorCode ierr;
PetscScalar val[5];
PetscReal z2 = PetscSqr( DELTA_Z ),
v = (2 * PetscSqr( DELTA_X ) + 4 * z2 ) / z2;
int i, j;
PetscFunctionBegin;
ierr = MatRetrieveValues(uc->A); CHKERRQ(ierr);
ierr = MatZeroEntries(uc->A); CHKERRQ(ierr);
Node *n;
for( i = 0; i < uc->numNodes; ++i)
{
n = &uc->nodes[i];
if( n->numNei == 4 )
{
for (j = 0; j < 4; ++j)
{
if(uc->nodes[n->nei[j]].numNei == 4)
{
val[j] = negone;
} else {
val[j] = zero;
}
}
val[4] = v;
ierr = MatSetValues(uc->A,1, &i, 5, n->nei, val, INSERT_VALUES); CHKERRQ(ierr);
} else {
ierr = MatSetValue(uc->A, i, i, one, INSERT_VALUES); CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(uc->A, MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
ierr = MatAssemblyEnd(uc->A, MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
// ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF, PETSC_VIEWER_ASCII_DENSE); CHKERRQ(ierr);
// ierr = MatView(uc->A, PETSC_VIEWER_STDOUT_SELF); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void PetscMatrix<T>::zero ()
{
libmesh_assert (this->initialized());
semiparallel_only();
PetscErrorCode ierr=0;
PetscInt m_l, n_l;
ierr = MatGetLocalSize(_mat,&m_l,&n_l);
LIBMESH_CHKERRABORT(ierr);
if (n_l)
{
ierr = MatZeroEntries(_mat);
LIBMESH_CHKERRABORT(ierr);
}
}
op_mat op_decl_mat( op_sparsity sparsity, int dim, char const * type, int type_size, char const * name )
{
assert( sparsity );
op_mat mat = op_decl_mat_core ( sparsity->rowmap->to, sparsity->colmap->to, dim, type, type_size, name );
Mat p_mat;
// Create a PETSc CSR sparse matrix and pre-allocate storage
MatCreateSeqAIJ(PETSC_COMM_SELF,
sparsity->nrows,
sparsity->ncols,
sparsity->max_nonzeros,
(const PetscInt*)sparsity->nnz,
&p_mat);
// Set the column indices (FIXME: benchmark if this is worth it)
MatSeqAIJSetColumnIndices(p_mat, (PetscInt*)sparsity->colidx);
MatZeroEntries(p_mat);
mat->mat = p_mat;
return mat;
}
/*
FormHessian - Forms the Hessian matrix.
Input Parameters:
. tao - the Tao context
. X - the input vector
. ptr - optional user-defined context, as set by TaoSetHessian()
Output Parameters:
. H - Hessian matrix
. PrecH - optionally different preconditioning Hessian
. flag - flag indicating matrix structure
Notes:
This routine is intended simply as an example of the interface
to a Hessian evaluation routine. Since this example compute the
Hessian a column at a time, it is not particularly efficient and
is not recommended.
*/
PetscErrorCode FormHessian(Tao tao,Vec X,Mat H,Mat Hpre, void *ptr)
{
AppCtx *user = (AppCtx *) ptr;
PetscErrorCode ierr;
PetscInt i,j, ndim = user->ndim;
PetscReal *y, zero = 0.0, one = 1.0;
PetscBool assembled;
user->xvec = X;
/* Initialize Hessian entries and work vector to zero */
ierr = MatAssembled(H,&assembled);CHKERRQ(ierr);
if (assembled){ierr = MatZeroEntries(H); CHKERRQ(ierr);}
ierr = VecSet(user->s, zero);CHKERRQ(ierr);
/* Loop over matrix columns to compute entries of the Hessian */
for (j=0; j<ndim; j++) {
ierr = VecSetValues(user->s,1,&j,&one,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(user->s);CHKERRQ(ierr);
ierr = VecAssemblyEnd(user->s);CHKERRQ(ierr);
ierr = HessianProduct(ptr,user->s,user->y);CHKERRQ(ierr);
ierr = VecSetValues(user->s,1,&j,&zero,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(user->s);CHKERRQ(ierr);
ierr = VecAssemblyEnd(user->s);CHKERRQ(ierr);
ierr = VecGetArray(user->y,&y);CHKERRQ(ierr);
for (i=0; i<ndim; i++) {
if (y[i] != zero) {
ierr = MatSetValues(H,1,&i,1,&j,&y[i],ADD_VALUES);CHKERRQ(ierr);
}
}
ierr = VecRestoreArray(user->y,&y);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
return 0;
}
PetscErrorCode _RHS_time_dep_ham(TS ts,PetscReal t,Vec X,Mat AA,Mat BB,void *ctx){
double time_dep_val;
PetscScalar time_dep_scalar;
int i,j;
operator op;
MatZeroEntries(AA);
MatCopy(full_A,AA,SAME_NONZERO_PATTERN);
for (i=0;i<_num_time_dep;i++){
time_dep_val = _time_dep_list[i].time_dep_func(t);
for(j=0;j<_time_dep_list[i].num_ops;j++){
op = _time_dep_list[i].ops[j];
/* Add -i *(I cross H(t)) */
time_dep_scalar = 0 - time_dep_val*PETSC_i;
_add_to_PETSc_kron(AA,time_dep_scalar,op->n_before,op->my_levels,
op->my_op_type,op->position,total_levels,1,0);
/* Add i *(H(t)^T cross I) */
time_dep_scalar = 0 + time_dep_val*PETSC_i;
_add_to_PETSc_kron(AA,time_dep_scalar,op->n_before,op->my_levels,
op->my_op_type,op->position,1,total_levels,1);
}
/* Consider putting _time_dep_func and _time_dep_mats in *ctx? */
}
MatAssemblyBegin(AA,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(AA,MAT_FINAL_ASSEMBLY);
if(AA!=BB) {
MatAssemblyBegin(AA,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(AA,MAT_FINAL_ASSEMBLY);
}
PetscFunctionReturn(0);
}
/*
FormJacobian - 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 FormJacobian(SNES snes,Vec x,Mat jac,Mat B,void *ctx)
{
PetscScalar *xx,A[3];
PetscErrorCode ierr;
PetscInt i,M,xs,xm;
DM da = (DM) ctx;
MatStencil row,cols[3];
PetscReal h;
PetscFunctionBeginUser;
/*
Get pointer to vector data
*/
ierr = DMDAVecGetArrayRead(da,x,&xx);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
/*
Get range of locally owned matrix
*/
ierr = DMDAGetInfo(da,NULL,&M,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = MatZeroEntries(jac);CHKERRQ(ierr);
h = 1.0/M;
/* because of periodic boundary conditions we can simply loop over all local nodes and access to the left and right */
for (i=xs; i<xs+xm; i++) {
row.i = i;
cols[0].i = i - 1;
cols[1].i = i;
cols[2].i = i + 1;
A[0] = A[2] = 1.0/(h*h); A[1] = -2.0/(h*h);
ierr = MatSetValuesStencil(jac,1,&row,3,cols,A,ADD_VALUES);CHKERRQ(ierr);
}
ierr = DMDAVecRestoreArrayRead(da,x,&xx);CHKERRQ(ierr);
ierr = MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormJacobian - Evaluates Jacobian matrix.
Input Parameters:
. snes - SNES context
. X - input vector
. ptr - optional user-defined context, as set by SNESSetJacobian()
Output Parameters:
. tH - Jacobian matrix
*/
PetscErrorCode FormJacobian(SNES snes, Vec X, Mat *tH, Mat *tHPre, MatStructure *flag, void *ptr)
{
AppCtx *user = (AppCtx*) ptr;
Mat H = *tH;
PetscErrorCode ierr;
PetscInt i,j,k;
PetscInt mx=user->mx, my=user->my;
MatStencil row,col[7];
PetscScalar hx=1.0/(mx+1), hy=1.0/(my+1), hydhx=hy/hx, hxdhy=hx/hy;
PetscScalar f1,f2,f3,f4,f5,f6,d1,d2,d3,d4,d5,d6,d7,d8,xc,xl,xr,xt,xb,xlt,xrb;
PetscScalar hl,hr,ht,hb,hc,htl,hbr;
PetscScalar **x, v[7];
PetscBool assembled;
PetscInt xs,xm,ys,ym;
Vec localX;
PetscScalar *top,*bottom,*left,*right;
PetscFunctionBeginUser;
/* Set various matrix options */
ierr = MatAssembled(H,&assembled);CHKERRQ(ierr);
if (assembled) {ierr = MatZeroEntries(H);CHKERRQ(ierr);}
*flag=SAME_NONZERO_PATTERN;
/* Get local vectors */
ierr = DMGetLocalVector(user->da,&localX);CHKERRQ(ierr);
ierr = VecGetArray(user->Top,&top);CHKERRQ(ierr);
ierr = VecGetArray(user->Bottom,&bottom);CHKERRQ(ierr);
ierr = VecGetArray(user->Left,&left);CHKERRQ(ierr);
ierr = VecGetArray(user->Right,&right);CHKERRQ(ierr);
/* Get ghost points */
ierr = DMGlobalToLocalBegin(user->da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(user->da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = DMDAVecGetArray(user->da,localX, &x);CHKERRQ(ierr);
ierr = DMDAGetCorners(user->da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
/* Compute Jacobian over the locally owned part of the mesh */
for (j=ys; j< ys+ym; j++) {
for (i=xs; i< xs+xm; i++) {
xc = x[j][i];
xlt=xrb=xl=xr=xb=xt=xc;
/* Left */
if (i==0) {
xl = left[j+1];
xlt = left[j+2];
} else xl = x[j][i-1];
/* Bottom */
if (j==0) {
xb = bottom[i+1];
xrb = bottom[i+2];
} else xb = x[j-1][i];
/* Right */
if (i+1 == mx) {
xr = right[j+1];
xrb = right[j];
} else xr = x[j][i+1];
/* Top */
if (j+1==my) {
xt = top[i+1];
xlt = top[i];
} else xt = x[j+1][i];
/* Top left */
if (i>0 && j+1<my) xlt = x[j+1][i-1];
/* Bottom right */
if (j>0 && i+1<mx) xrb = x[j-1][i+1];
d1 = (xc-xl)/hx;
d2 = (xc-xr)/hx;
d3 = (xc-xt)/hy;
d4 = (xc-xb)/hy;
d5 = (xrb-xr)/hy;
d6 = (xrb-xb)/hx;
d7 = (xlt-xl)/hy;
d8 = (xlt-xt)/hx;
f1 = PetscSqrtReal(1.0 + d1*d1 + d7*d7);
f2 = PetscSqrtReal(1.0 + d1*d1 + d4*d4);
f3 = PetscSqrtReal(1.0 + d3*d3 + d8*d8);
f4 = PetscSqrtReal(1.0 + d3*d3 + d2*d2);
f5 = PetscSqrtReal(1.0 + d2*d2 + d5*d5);
f6 = PetscSqrtReal(1.0 + d4*d4 + d6*d6);
hl = (-hydhx*(1.0+d7*d7)+d1*d7)/(f1*f1*f1)+
(-hydhx*(1.0+d4*d4)+d1*d4)/(f2*f2*f2);
hr = (-hydhx*(1.0+d5*d5)+d2*d5)/(f5*f5*f5)+
(-hydhx*(1.0+d3*d3)+d2*d3)/(f4*f4*f4);
ht = (-hxdhy*(1.0+d8*d8)+d3*d8)/(f3*f3*f3)+
(-hxdhy*(1.0+d2*d2)+d2*d3)/(f4*f4*f4);
hb = (-hxdhy*(1.0+d6*d6)+d4*d6)/(f6*f6*f6)+
(-hxdhy*(1.0+d1*d1)+d1*d4)/(f2*f2*f2);
hbr = -d2*d5/(f5*f5*f5) - d4*d6/(f6*f6*f6);
htl = -d1*d7/(f1*f1*f1) - d3*d8/(f3*f3*f3);
hc = hydhx*(1.0+d7*d7)/(f1*f1*f1) + hxdhy*(1.0+d8*d8)/(f3*f3*f3) +
hydhx*(1.0+d5*d5)/(f5*f5*f5) + hxdhy*(1.0+d6*d6)/(f6*f6*f6) +
(hxdhy*(1.0+d1*d1)+hydhx*(1.0+d4*d4)-2*d1*d4)/(f2*f2*f2) +
(hxdhy*(1.0+d2*d2)+hydhx*(1.0+d3*d3)-2*d2*d3)/(f4*f4*f4);
hl/=2.0; hr/=2.0; ht/=2.0; hb/=2.0; hbr/=2.0; htl/=2.0; hc/=2.0;
k = 0;
row.i = i;row.j = j;
/* Bottom */
if (j>0) {
v[k] = hb;
col[k].i = i; col[k].j=j-1; k++;
}
/* Bottom right */
if (j>0 && i < mx -1) {
v[k] = hbr;
col[k].i = i+1; col[k].j = j-1; k++;
}
/* left */
if (i>0) {
v[k] = hl;
col[k].i = i-1; col[k].j = j; k++;
}
/* Centre */
v[k]= hc; col[k].i= row.i; col[k].j = row.j; k++;
/* Right */
if (i < mx-1) {
v[k] = hr;
col[k].i= i+1; col[k].j = j;k++;
}
/* Top left */
if (i>0 && j < my-1) {
v[k] = htl;
col[k].i = i-1;col[k].j = j+1; k++;
}
/* Top */
if (j < my-1) {
v[k] = ht;
col[k].i = i; col[k].j = j+1; k++;
}
ierr = MatSetValuesStencil(H,1,&row,k,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecRestoreArray(user->Left,&left);CHKERRQ(ierr);
ierr = VecRestoreArray(user->Top,&top);CHKERRQ(ierr);
ierr = VecRestoreArray(user->Bottom,&bottom);CHKERRQ(ierr);
ierr = VecRestoreArray(user->Right,&right);CHKERRQ(ierr);
/* Assemble the matrix */
ierr = MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(user->da,localX,&x);CHKERRQ(ierr);
ierr = MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(user->da,&localX);CHKERRQ(ierr);
ierr = PetscLogFlops(199*mx*my);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat C,A;
PetscInt i, n = 10,midx[3],bs=1;
PetscErrorCode ierr;
PetscScalar v[3];
PetscBool flg,isAIJ;
MatType type;
PetscMPIInt size;
PetscInitialize(&argc,&args,(char *)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-mat_block_size",&bs,PETSC_NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetType(C,MATAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatGetType(C,&type);CHKERRQ(ierr);
if (size == 1){
ierr = PetscObjectTypeCompare((PetscObject)C,MATSEQAIJ,&isAIJ);CHKERRQ(ierr);
} else {
ierr = PetscObjectTypeCompare((PetscObject)C,MATMPIAIJ,&isAIJ);CHKERRQ(ierr);
}
ierr = MatSeqAIJSetPreallocation(C,3,PETSC_NULL);
ierr = MatMPIAIJSetPreallocation(C,3,PETSC_NULL,3,PETSC_NULL);CHKERRQ(ierr);
ierr = MatSeqBAIJSetPreallocation(C,bs,3,PETSC_NULL);
ierr = MatMPIBAIJSetPreallocation(C,bs,3,PETSC_NULL,3,PETSC_NULL);CHKERRQ(ierr);
v[0] = -1.; v[1] = 2.; v[2] = -1.;
for (i=1; i<n-1; i++){
midx[2] = i-1; midx[1] = i; midx[0] = i+1;
ierr = MatSetValues(C,1,&i,3,midx,v,INSERT_VALUES);CHKERRQ(ierr);
}
i = 0; midx[0] = 0; midx[1] = 1;
v[0] = 2.0; v[1] = -1.;
ierr = MatSetValues(C,1,&i,2,midx,v,INSERT_VALUES);CHKERRQ(ierr);
i = n-1; midx[0] = n-2; midx[1] = n-1;
v[0] = -1.0; v[1] = 2.;
ierr = MatSetValues(C,1,&i,2,midx,v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
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 = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* test matrices with different nonzero patterns - Note: A is created with different nonzero pattern of C! */
ierr = MatCopy(C,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatEqual(A,C,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"MatCopy(C,A,DIFFERENT_NONZERO_PATTERN): Matrices are NOT equal");
ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"A is obtained with MatCopy(,,DIFFERENT_NONZERO_PATTERN):\n");CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
/* test matrices with same nonzero pattern */
ierr = MatDuplicate(C,MAT_DO_NOT_COPY_VALUES,&A);CHKERRQ(ierr);
ierr = MatCopy(C,A,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatEqual(A,C,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"MatCopy(C,A,SAME_NONZERO_PATTERN): Matrices are NOT equal");
ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nA is obtained with MatCopy(,,SAME_NONZERO_PATTERN):\n");CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_COMMON);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"A:\n");CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* test MatStore/RetrieveValues() */
if (isAIJ){
ierr = MatSetOption(A,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);CHKERRQ(ierr);
ierr = MatStoreValues(A);CHKERRQ(ierr);
ierr = MatZeroEntries(A);CHKERRQ(ierr);
ierr = MatRetrieveValues(A);CHKERRQ(ierr);
}
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **args)
{
Vec x1,b1,x2,b2; /* solution and RHS vectors for systems #1 and #2 */
Vec u; /* exact solution vector */
Mat C1,C2; /* matrices for systems #1 and #2 */
KSP ksp1,ksp2; /* KSP contexts for systems #1 and #2 */
PetscInt ntimes = 3; /* number of times to solve the linear systems */
PetscLogEvent CHECK_ERROR; /* event number for error checking */
PetscInt ldim,low,high,iglobal,Istart,Iend,Istart2,Iend2;
PetscInt Ii,J,i,j,m = 3,n = 2,its,t;
PetscErrorCode ierr;
PetscBool flg = PETSC_FALSE;
PetscScalar v;
PetscMPIInt rank,size;
#if defined (PETSC_USE_LOG)
PetscLogStage stages[3];
#endif
PetscInitialize(&argc,&args,(char *)0,help);
ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-t",&ntimes,PETSC_NULL);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
n = 2*size;
/*
Register various stages for profiling
*/
ierr = PetscLogStageRegister("Prelim setup",&stages[0]);CHKERRQ(ierr);
ierr = PetscLogStageRegister("Linear System 1",&stages[1]);CHKERRQ(ierr);
ierr = PetscLogStageRegister("Linear System 2",&stages[2]);CHKERRQ(ierr);
/*
Register a user-defined event for profiling (error checking).
*/
CHECK_ERROR = 0;
ierr = PetscLogEventRegister("Check Error",KSP_CLASSID,&CHECK_ERROR);CHKERRQ(ierr);
/* - - - - - - - - - - - - Stage 0: - - - - - - - - - - - - - -
Preliminary Setup
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscLogStagePush(stages[0]);CHKERRQ(ierr);
/*
Create data structures for first linear system.
- Create parallel matrix, specifying only its global dimensions.
When using MatCreate(), the matrix format can be specified at
runtime. Also, the parallel partitioning of the matrix is
determined by PETSc at runtime.
- Create parallel vectors.
- When using VecSetSizes(), 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.
*/
ierr = MatCreate(PETSC_COMM_WORLD,&C1);CHKERRQ(ierr);
ierr = MatSetSizes(C1,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr);
ierr = MatSetFromOptions(C1);CHKERRQ(ierr);
ierr = MatSetUp(C1);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C1,&Istart,&Iend);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr);
ierr = VecSetSizes(u,PETSC_DECIDE,m*n);CHKERRQ(ierr);
ierr = VecSetFromOptions(u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b1);CHKERRQ(ierr);
ierr = VecDuplicate(u,&x1);CHKERRQ(ierr);
/*
Create first linear solver context.
Set runtime options (e.g., -pc_type <type>).
Note that the first linear system uses the default option
names, while the second linear systme uses a different
options prefix.
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp1);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp1);CHKERRQ(ierr);
/*
Set user-defined monitoring routine for first linear system.
*/
ierr = PetscOptionsGetBool(PETSC_NULL,"-my_ksp_monitor",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) {ierr = KSPMonitorSet(ksp1,MyKSPMonitor,PETSC_NULL,0);CHKERRQ(ierr);}
/*
Create data structures for second linear system.
*/
ierr = MatCreate(PETSC_COMM_WORLD,&C2);CHKERRQ(ierr);
ierr = MatSetSizes(C2,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr);
ierr = MatSetFromOptions(C2);CHKERRQ(ierr);
ierr = MatSetUp(C2);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C2,&Istart2,&Iend2);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b2);CHKERRQ(ierr);
ierr = VecDuplicate(u,&x2);CHKERRQ(ierr);
/*
Create second linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp2);CHKERRQ(ierr);
/*
Set different options prefix for second linear system.
Set runtime options (e.g., -s2_pc_type <type>)
*/
ierr = KSPAppendOptionsPrefix(ksp2,"s2_");CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp2);CHKERRQ(ierr);
/*
Assemble exact solution vector in parallel. Note that each
processor needs to set only its local part of the vector.
*/
ierr = VecGetLocalSize(u,&ldim);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(u,&low,&high);CHKERRQ(ierr);
for (i=0; i<ldim; i++) {
iglobal = i + low;
v = (PetscScalar)(i + 100*rank);
ierr = VecSetValues(u,1,&iglobal,&v,ADD_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(u);CHKERRQ(ierr);
ierr = VecAssemblyEnd(u);CHKERRQ(ierr);
/*
Log the number of flops for computing vector entries
*/
ierr = PetscLogFlops(2.0*ldim);CHKERRQ(ierr);
/*
End curent profiling stage
*/
ierr = PetscLogStagePop();CHKERRQ(ierr);
/* --------------------------------------------------------------
Linear solver loop:
Solve 2 different linear systems several times in succession
-------------------------------------------------------------- */
for (t=0; t<ntimes; t++) {
/* - - - - - - - - - - - - Stage 1: - - - - - - - - - - - - - -
Assemble and solve first linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Begin profiling stage #1
*/
ierr = PetscLogStagePush(stages[1]);CHKERRQ(ierr);
/*
Initialize all matrix entries to zero. MatZeroEntries() retains
the nonzero structure of the matrix for sparse formats.
*/
if (t > 0) {ierr = MatZeroEntries(C1);CHKERRQ(ierr);}
/*
Set matrix entries in parallel. Also, log the number of flops
for computing matrix entries.
- Each processor needs to insert only elements that it owns
locally (but any non-local elements will be sent to the
appropriate processor during matrix assembly).
- Always specify global row and columns of matrix entries.
*/
for (Ii=Istart; Ii<Iend; Ii++) {
v = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {J = Ii - n; ierr = MatSetValues(C1,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (i<m-1) {J = Ii + n; ierr = MatSetValues(C1,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j>0) {J = Ii - 1; ierr = MatSetValues(C1,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j<n-1) {J = Ii + 1; ierr = MatSetValues(C1,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
v = 4.0; ierr = MatSetValues(C1,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
for (Ii=Istart; Ii<Iend; Ii++) { /* Make matrix nonsymmetric */
v = -1.0*(t+0.5); i = Ii/n;
if (i>0) {J = Ii - n; ierr = MatSetValues(C1,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
}
ierr = PetscLogFlops(2.0*(Iend-Istart));CHKERRQ(ierr);
/*
Assemble matrix, using the 2-step process:
MatAssemblyBegin(), MatAssemblyEnd()
Computations can be done while messages are in transition
by placing code between these two statements.
*/
ierr = MatAssemblyBegin(C1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C1,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/*
Indicate same nonzero structure of successive linear system matrices
*/
ierr = MatSetOption(C1,MAT_NEW_NONZERO_LOCATIONS,PETSC_TRUE);CHKERRQ(ierr);
/*
Compute right-hand-side vector
*/
ierr = MatMult(C1,u,b1);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
- The flag SAME_NONZERO_PATTERN indicates that the
preconditioning matrix has identical nonzero structure
as during the last linear solve (although the values of
the entries have changed). Thus, we can save some
work in setting up the preconditioner (e.g., no need to
redo symbolic factorization for ILU/ICC preconditioners).
- If the nonzero structure of the matrix is different during
the second linear solve, then the flag DIFFERENT_NONZERO_PATTERN
must be used instead. If you are unsure whether the
matrix structure has changed or not, use the flag
DIFFERENT_NONZERO_PATTERN.
- Caution: If you specify SAME_NONZERO_PATTERN, PETSc
believes your assertion and does not check the structure
of the matrix. If you erroneously claim that the structure
is the same when it actually is not, the new preconditioner
will not function correctly. Thus, use this optimization
feature with caution!
*/
ierr = KSPSetOperators(ksp1,C1,C1,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
/*
Use the previous solution of linear system #1 as the initial
guess for the next solve of linear system #1. The user MUST
call KSPSetInitialGuessNonzero() in indicate use of an initial
guess vector; otherwise, an initial guess of zero is used.
*/
if (t>0) {
ierr = KSPSetInitialGuessNonzero(ksp1,PETSC_TRUE);CHKERRQ(ierr);
}
/*
Solve the first linear system. Here we explicitly call
KSPSetUp() for more detailed performance monitoring of
certain preconditioners, such as ICC and ILU. This call
is optional, ase KSPSetUp() will automatically be called
within KSPSolve() if it hasn't been called already.
*/
ierr = KSPSetUp(ksp1);CHKERRQ(ierr);
ierr = KSPSolve(ksp1,b1,x1);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp1,&its);CHKERRQ(ierr);
/*
Check error of solution to first linear system
*/
ierr = CheckError(u,x1,b1,its,1.e-4,CHECK_ERROR);CHKERRQ(ierr);
/* - - - - - - - - - - - - Stage 2: - - - - - - - - - - - - - -
Assemble and solve second linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Conclude profiling stage #1; begin profiling stage #2
*/
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = PetscLogStagePush(stages[2]);CHKERRQ(ierr);
/*
Initialize all matrix entries to zero
*/
if (t > 0) {ierr = MatZeroEntries(C2);CHKERRQ(ierr);}
/*
Assemble matrix in parallel. Also, log the number of flops
for computing matrix entries.
- To illustrate the features of parallel matrix assembly, we
intentionally set the values differently from the way in
which the matrix is distributed across the processors. Each
entry that is not owned locally will be sent to the appropriate
processor during MatAssemblyBegin() and MatAssemblyEnd().
- For best efficiency the user should strive to set as many
entries locally as possible.
*/
for (i=0; i<m; i++) {
for (j=2*rank; j<2*rank+2; j++) {
v = -1.0; Ii = j + n*i;
if (i>0) {J = Ii - n; ierr = MatSetValues(C2,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (i<m-1) {J = Ii + n; ierr = MatSetValues(C2,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j>0) {J = Ii - 1; ierr = MatSetValues(C2,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j<n-1) {J = Ii + 1; ierr = MatSetValues(C2,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
v = 6.0 + t*0.5; ierr = MatSetValues(C2,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
}
for (Ii=Istart2; Ii<Iend2; Ii++) { /* Make matrix nonsymmetric */
v = -1.0*(t+0.5); i = Ii/n;
if (i>0) {J = Ii - n; ierr = MatSetValues(C2,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
}
ierr = MatAssemblyBegin(C2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C2,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscLogFlops(2.0*(Iend-Istart));CHKERRQ(ierr);
/*
Indicate same nonzero structure of successive linear system matrices
*/
ierr = MatSetOption(C2,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);CHKERRQ(ierr);
/*
Compute right-hand-side vector
*/
ierr = MatMult(C2,u,b2);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix. Indicate same nonzero
structure of successive preconditioner matrices by setting flag
SAME_NONZERO_PATTERN.
*/
ierr = KSPSetOperators(ksp2,C2,C2,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
/*
Solve the second linear system
*/
ierr = KSPSetUp(ksp2);CHKERRQ(ierr);
ierr = KSPSolve(ksp2,b2,x2);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp2,&its);CHKERRQ(ierr);
/*
Check error of solution to second linear system
*/
ierr = CheckError(u,x2,b2,its,1.e-4,CHECK_ERROR);CHKERRQ(ierr);
/*
Conclude profiling stage #2
*/
ierr = PetscLogStagePop();CHKERRQ(ierr);
}
/* --------------------------------------------------------------
End of linear solver loop
-------------------------------------------------------------- */
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = KSPDestroy(&ksp1);CHKERRQ(ierr); ierr = KSPDestroy(&ksp2);CHKERRQ(ierr);
ierr = VecDestroy(&x1);CHKERRQ(ierr); ierr = VecDestroy(&x2);CHKERRQ(ierr);
ierr = VecDestroy(&b1);CHKERRQ(ierr); ierr = VecDestroy(&b2);CHKERRQ(ierr);
ierr = MatDestroy(&C1);CHKERRQ(ierr); ierr = MatDestroy(&C2);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
