PetscErrorCode DMCreateInterpolation_Composite(DM coarse,DM fine,Mat *A,Vec *v)
{
PetscErrorCode ierr;
PetscInt m,n,M,N,nDM,i;
struct DMCompositeLink *nextc;
struct DMCompositeLink *nextf;
Vec gcoarse,gfine,*vecs;
DM_Composite *comcoarse = (DM_Composite*)coarse->data;
DM_Composite *comfine = (DM_Composite*)fine->data;
Mat *mats;
PetscFunctionBegin;
PetscValidHeaderSpecific(coarse,DM_CLASSID,1);
PetscValidHeaderSpecific(fine,DM_CLASSID,2);
ierr = DMSetUp(coarse);CHKERRQ(ierr);
ierr = DMSetUp(fine);CHKERRQ(ierr);
/* use global vectors only for determining matrix layout */
ierr = DMGetGlobalVector(coarse,&gcoarse);CHKERRQ(ierr);
ierr = DMGetGlobalVector(fine,&gfine);CHKERRQ(ierr);
ierr = VecGetLocalSize(gcoarse,&n);CHKERRQ(ierr);
ierr = VecGetLocalSize(gfine,&m);CHKERRQ(ierr);
ierr = VecGetSize(gcoarse,&N);CHKERRQ(ierr);
ierr = VecGetSize(gfine,&M);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(coarse,&gcoarse);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(fine,&gfine);CHKERRQ(ierr);
nDM = comfine->nDM;
if (nDM != comcoarse->nDM) SETERRQ2(((PetscObject)fine)->comm,PETSC_ERR_ARG_INCOMP,"Fine DMComposite has %D entries, but coarse has %D",nDM,comcoarse->nDM);
ierr = PetscMalloc(nDM*nDM*sizeof(Mat),&mats);CHKERRQ(ierr);
ierr = PetscMemzero(mats,nDM*nDM*sizeof(Mat));CHKERRQ(ierr);
if (v) {
ierr = PetscMalloc(nDM*sizeof(Vec),&vecs);CHKERRQ(ierr);
ierr = PetscMemzero(vecs,nDM*sizeof(Vec));CHKERRQ(ierr);
}
/* loop over packed objects, handling one at at time */
for (nextc=comcoarse->next,nextf=comfine->next,i=0; nextc; nextc=nextc->next,nextf=nextf->next,i++) {
if (!v) {
ierr = DMCreateInterpolation(nextc->dm,nextf->dm,&mats[i*nDM+i],PETSC_NULL);CHKERRQ(ierr);
} else {
ierr = DMCreateInterpolation(nextc->dm,nextf->dm,&mats[i*nDM+i],&vecs[i]);CHKERRQ(ierr);
}
}
ierr = MatCreateNest(((PetscObject)fine)->comm,nDM,PETSC_NULL,nDM,PETSC_NULL,mats,A);CHKERRQ(ierr);
if (v) {
ierr = VecCreateNest(((PetscObject)fine)->comm,nDM,PETSC_NULL,vecs,v);CHKERRQ(ierr);
}
for (i=0; i<nDM*nDM; i++) {ierr = MatDestroy(&mats[i]);CHKERRQ(ierr);}
ierr = PetscFree(mats);CHKERRQ(ierr);
if (v) {
for (i=0; i<nDM; i++) {ierr = VecDestroy(&vecs[i]);CHKERRQ(ierr);}
ierr = PetscFree(vecs);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode StokesSetupMatrix(Stokes *s)
{
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = StokesSetupMatBlock00(s);CHKERRQ(ierr);
ierr = StokesSetupMatBlock01(s);CHKERRQ(ierr);
ierr = StokesSetupMatBlock10(s);CHKERRQ(ierr);
ierr = StokesSetupMatBlock11(s);CHKERRQ(ierr);
ierr = MatCreateNest(PETSC_COMM_WORLD, 2, NULL, 2, NULL, s->subA, &s->A);CHKERRQ(ierr);
ierr = StokesSetupApproxSchur(s);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode DMCreateMatrix_Composite_Nest(DM dm,MatType mtype,Mat *J)
{
const DM_Composite *com = (DM_Composite*)dm->data;
const struct DMCompositeLink *rlink,*clink;
PetscErrorCode ierr;
IS *isg;
Mat *submats;
PetscInt i,j,n;
PetscFunctionBegin;
n = com->nDM; /* Total number of entries */
/* Explicit index sets are not required for MatCreateNest, but getting them here allows MatNest to do consistency
* checking and allows ISEqual to compare by identity instead of by contents. */
ierr = DMCompositeGetGlobalISs(dm,&isg);CHKERRQ(ierr);
/* Get submatrices */
ierr = PetscMalloc(n*n*sizeof(Mat),&submats);CHKERRQ(ierr);
for (i=0,rlink=com->next; rlink; i++,rlink=rlink->next) {
for (j=0,clink=com->next; clink; j++,clink=clink->next) {
Mat sub = NULL;
if (i == j) {
ierr = DMCreateMatrix(rlink->dm,NULL,&sub);CHKERRQ(ierr);
} else if (com->FormCoupleLocations) SETERRQ(PetscObjectComm((PetscObject)dm),PETSC_ERR_SUP,"Cannot manage off-diagonal parts yet");
submats[i*n+j] = sub;
}
}
ierr = MatCreateNest(PetscObjectComm((PetscObject)dm),n,isg,n,isg,submats,J);CHKERRQ(ierr);
/* Disown references */
for (i=0; i<n; i++) {ierr = ISDestroy(&isg[i]);CHKERRQ(ierr);}
ierr = PetscFree(isg);CHKERRQ(ierr);
for (i=0; i<n*n; i++) {
if (submats[i]) {ierr = MatDestroy(&submats[i]);CHKERRQ(ierr);}
}
ierr = PetscFree(submats);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PETSC_EXTERN void PETSC_STDCALL matcreatenest_(MPI_Fint *comm,PetscInt *nr,IS is_row[],PetscInt *nc,IS is_col[],Mat a[],Mat *B,int *ierr)
{
CHKFORTRANNULLOBJECT(is_row);
CHKFORTRANNULLOBJECT(is_col);
*ierr = MatCreateNest(MPI_Comm_f2c(*comm),*nr,is_row,*nc,is_col,a,B);
}
PetscErrorCode DMCoarsen_AKKT(DM dm, MPI_Comm comm, DM *cdm) {
PetscErrorCode ierr;
DM_AKKT* kkt = (DM_AKKT*)(dm->data);
Mat Acc; /* coarse-level KKT matrix */
Mat P0f0c, P1f1c; /* Primal and dual block prolongator */
DM dmc[2] = {PETSC_NULL, PETSC_NULL}; /* Coarse subDMs defining the block prolongators and the coarsened decomposition. */
PetscInt M0,N0,M1,N1; /* Sizes of P0f0c and P1f1c. */
PetscInt start0,end0,start1,end1; /* Ownership ranges for P0f0c and P1f1c. */
static Mat mats[4] = {PETSC_NULL, PETSC_NULL, PETSC_NULL, PETSC_NULL}; /* Used to construct MatNest out of pieces. */
IS isc[2]; /* Used to construct MatNest out of pieces and to define the coarsened decomposition. */
PetscFunctionBegin;
if(!cdm) PetscFunctionReturn(0);
if(kkt->cdm) {
ierr = PetscObjectReference((PetscObject)(kkt->cdm)); CHKERRQ(ierr);
*cdm = kkt->cdm;
PetscFunctionReturn(0);
}
/* Coarsen the 00 block with the attached DM and obtain the primal prolongator. */
if(kkt->dmf[0]) {
ierr = DMCoarsen(kkt->dmf[0], comm, dmc+0); CHKERRQ(ierr);
ierr = DMCreateInterpolation(dmc[0], kkt->dmf[0], &P0f0c, PETSC_NULL); CHKERRQ(ierr);
}
else SETERRQ(((PetscObject)dm)->comm, PETSC_ERR_ARG_WRONGSTATE, "Could not coarsen the primal block: primal subDM not set.");
/* Should P0f0c be transposed to act as a prolongator (i.e., to map from coarse to fine). */
ierr = MatGetSize(P0f0c, &M0, &N0); CHKERRQ(ierr);
if(M0 == N0) SETERRQ1(((PetscObject)dm)->comm, PETSC_ERR_ARG_WRONGSTATE,"Primal prolongator is square with size %D: cannot distinguish coarse from fine",M0);
if(M0 < N0) kkt->transposeP = PETSC_TRUE;
else kkt->transposeP = PETSC_FALSE;
/* See if the 11 block can be coarsened with an attached DM. If so, we are done. Otherwise, use GAMG to coarsen 11. */
if(kkt->dmf[1]) {
ierr = DMCoarsen(kkt->dmf[1], comm, &dmc[1]); CHKERRQ(ierr);
ierr = DMCreateInterpolation(dmc[1], kkt->dmf[1], &P1f1c, PETSC_NULL); CHKERRQ(ierr);
}
else {
ierr = DMCoarsen_AKKT_GAMG11(dm, P0f0c, &P1f1c); CHKERRQ(ierr);
}
/* Determine whether P1f1c should be transposed in order to act as a prolongator (i.e., to map from coarse to fine). */
ierr = MatGetSize(P1f1c, &M1, &N1); CHKERRQ(ierr);
if(M1 == N1) SETERRQ1(((PetscObject)dm)->comm, PETSC_ERR_ARG_WRONGSTATE, "Dual prlongator is square with size %D: cannot distinguish coarse from fine", M1);
if((M1 < N1 && !kkt->transposeP) || (M1 >= N1 && kkt->transposeP)) {
Mat P1f1ct;
ierr = MatTranspose(P1f1c, MAT_INITIAL_MATRIX, &P1f1ct); CHKERRQ(ierr);
ierr = MatDestroy(&P1f1c); CHKERRQ(ierr);
P1f1c = P1f1ct;
}
/* MatNest P0f0c, P1f1c together into Pfc. */
mats[0] = P0f0c; mats[3] = P1f1c;
ierr = MatGetOwnershipRange(P0f0c, &start0, &end0); CHKERRQ(ierr);
ierr = MatGetOwnershipRange(P1f1c, &start1, &end1); CHKERRQ(ierr);
ierr = ISCreateStride(((PetscObject)dm)->comm, end0-start0,start0,1,isc+0); CHKERRQ(ierr);
ierr = ISCreateStride(((PetscObject)dm)->comm, end1-start1,start1,1,isc+1); CHKERRQ(ierr);
if(kkt->transposeP) {
ierr = MatCreateNest(((PetscObject)dm)->comm,2,isc,2,kkt->isf,mats,&(kkt->Pfc)); CHKERRQ(ierr);
}
else {
ierr = MatCreateNest(((PetscObject)dm)->comm,2,kkt->isf,2,isc,mats,&(kkt->Pfc)); CHKERRQ(ierr);
}
ierr = MatDestroy(&P0f0c); CHKERRQ(ierr);
ierr = MatDestroy(&P1f1c); CHKERRQ(ierr);
/* Coarsening the underlying matrix and primal-dual decomposition. */
/*
We do not coarsen the underlying DM because
(a) Its coarsening may be incompatible with the specialized KKT-aware coarsening of the blocks defined here.
(b) Even if the coarsening the decomposition is compatible with the decomposition of the coarsening, we can
pick the former without loss of generality.
(c) Even if (b) is true, the embeddings (IS) of the coarsened subDMs are potentially different now from what
they would be in the coarsened DM; thus, embeddings would have to be supplied manually anyhow.
(d) In the typical situation we should only use the primal subDM for coarsening -- the whole point of
DMAKKT is that the dual block coarsening should be derived from the primal block coarsening for compatibility.
If we are given both subDMs, DMAKKT essentially becomes a version of DMComposite, in which case the composition
of the coarsened decomposition is by definition the coarsening of the whole system DM.
*/
/* Create the coarser DM. */
ierr = DMCreate(((PetscObject)dm)->comm, &(kkt->cdm)); CHKERRQ(ierr);
ierr = DMSetType(kkt->cdm, DMAKKT); CHKERRQ(ierr);
/* Coarsen the underlying matrix. */
ierr = MatPtAP(kkt->Aff, kkt->Pfc, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &Acc); CHKERRQ(ierr);
ierr = DMAKKTSetMatrix(dm, Acc); CHKERRQ(ierr);
/* Set the coarsened decomposition. */
ierr = DMAKKTSetFieldDecomposition(kkt->cdm, 2, (const char**)kkt->names, isc, dmc); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode LoadTestMatrices(Mat *_A,Vec *_x,Vec *_b,IS *_isu,IS *_isp)
{
Vec f,h,x,b,bX[2];
Mat A,Auu,Aup,Apu,App,bA[2][2];
IS is_u,is_p,bis[2];
PetscInt lnu,lnp,nu,np,i,start_u,end_u,start_p,end_p;
VecScatter *vscat;
PetscMPIInt rank;
PetscErrorCode ierr;
PetscFunctionBeginUser;
/* fetch test matrices and vectors */
ierr = LSCLoadTestOperators(&Auu,&Aup,&Apu,&App,&f,&h);CHKERRQ(ierr);
/* build the mat-nest */
ierr = VecGetSize(f,&nu);CHKERRQ(ierr);
ierr = VecGetSize(h,&np);CHKERRQ(ierr);
ierr = VecGetLocalSize(f,&lnu);CHKERRQ(ierr);
ierr = VecGetLocalSize(h,&lnp);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(f,&start_u,&end_u);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(h,&start_p,&end_p);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d] lnu = %D | lnp = %D \n", rank, lnu, lnp);CHKERRQ(ierr);
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d] s_u = %D | e_u = %D \n", rank, start_u, end_u);CHKERRQ(ierr);
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d] s_p = %D | e_p = %D \n", rank, start_p, end_p);CHKERRQ(ierr);
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d] is_u (offset) = %D \n", rank, start_u+start_p);CHKERRQ(ierr);
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d] is_p (offset) = %D \n", rank, start_u+start_p+lnu);CHKERRQ(ierr);
ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,PETSC_STDOUT);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_WORLD,lnu,start_u+start_p,1,&is_u);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_WORLD,lnp,start_u+start_p+lnu,1,&is_p);CHKERRQ(ierr);
bis[0] = is_u; bis[1] = is_p;
bA[0][0] = Auu; bA[0][1] = Aup;
bA[1][0] = Apu; bA[1][1] = App;
ierr = MatCreateNest(PETSC_COMM_WORLD,2,bis,2,bis,&bA[0][0],&A);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Pull f,h into b */
ierr = MatCreateVecs(A,&b,&x);CHKERRQ(ierr);
bX[0] = f; bX[1] = h;
ierr = PetscMalloc1(2,&vscat);CHKERRQ(ierr);
for (i=0; i<2; i++) {
ierr = VecScatterCreate(b,bis[i],bX[i],NULL,&vscat[i]);CHKERRQ(ierr);
ierr = VecScatterBegin(vscat[i],bX[i],b,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
}
for (i=0; i<2; i++) {
ierr = VecScatterEnd(vscat[i],bX[i],b,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
}
/* tidy up */
for (i=0; i<2; i++) {
ierr = VecScatterDestroy(&vscat[i]);CHKERRQ(ierr);
}
ierr = PetscFree(vscat);CHKERRQ(ierr);
ierr = MatDestroy(&Auu);CHKERRQ(ierr);
ierr = MatDestroy(&Aup);CHKERRQ(ierr);
ierr = MatDestroy(&Apu);CHKERRQ(ierr);
ierr = MatDestroy(&App);CHKERRQ(ierr);
ierr = VecDestroy(&f);CHKERRQ(ierr);
ierr = VecDestroy(&h);CHKERRQ(ierr);
*_isu = is_u;
*_isp = is_p;
*_A = A;
*_x = x;
*_b = b;
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);
}
PetscErrorCode _BlockSolve( void* solver, void* _stokesSLE ) {
Stokes_SLE* stokesSLE = (Stokes_SLE*)_stokesSLE;
StokesBlockKSPInterface* Solver = (StokesBlockKSPInterface*)solver;
/* Create shortcuts to stuff needed on sle */
Mat K;
Mat G;
Mat Gt;
Mat D;
Mat C;
Mat approxS;
Vec u;
Vec p;
Vec f;
Vec h;
Mat stokes_P;
Mat stokes_A;
Vec stokes_x;
Vec stokes_b;
Mat a[2][2];
Vec x[2];
Vec b[2];
KSP stokes_ksp;
PC stokes_pc;
PetscTruth sym,flg;
PetscErrorCode ierr;
PetscInt N,n;
SBKSP_GetStokesOperators( stokesSLE, &K,&G,&D,&C, &approxS, &f,&h, &u,&p );
/* create Gt */
if( !D ) {
ierr = MatTranspose( G, MAT_INITIAL_MATRIX, &Gt);CHKERRQ(ierr);
sym = PETSC_TRUE;
Solver->DIsSym = sym;
}
else {
Gt = D;
sym = PETSC_FALSE;
Solver->DIsSym = sym;
}
flg=PETSC_FALSE;
PetscOptionsHasName(PETSC_NULL,"-use_petsc_ksp",&flg);
if (flg) {
if( !C ) {
/* Everything in this bracket, dependent on !C, is to build
a matrix with diagonals of 0 for C the previous comment ways
need a 'zero' matrix to keep fieldsplit happy in petsc? */
MatType mtype;
Vec V;
//MatGetSize( G, &M, &N );
VecGetSize(p, &N);
VecGetLocalSize( p, &n );
MatCreate( PetscObjectComm((PetscObject) K), &C );
MatSetSizes( C, PETSC_DECIDE ,PETSC_DECIDE, N, N );
#if (((PETSC_VERSION_MAJOR==3) && (PETSC_VERSION_MINOR>=3)) || (PETSC_VERSION_MAJOR>3) )
MatSetUp(C);
#endif
MatGetType( G, &mtype );
MatSetType( C, mtype );
MatGetVecs( G, &V, PETSC_NULL );
VecSet(V, 0.0);
//VecSet(h, 1.0);
ierr = VecAssemblyBegin( V );CHKERRQ(ierr);
ierr = VecAssemblyEnd ( V );CHKERRQ(ierr);
ierr = MatDiagonalSet(C,V,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin( C, MAT_FINAL_ASSEMBLY );CHKERRQ(ierr);
ierr = MatAssemblyEnd ( C, MAT_FINAL_ASSEMBLY );CHKERRQ(ierr);
}
}
a[0][0]=K; a[0][1]=G;
a[1][0]=Gt; a[1][1]=C;
ierr = MatCreateNest(PetscObjectComm((PetscObject) K), 2, NULL, 2, NULL, (Mat *)a, &stokes_A);CHKERRQ(ierr);
ierr = MatAssemblyBegin( stokes_A, MAT_FINAL_ASSEMBLY );CHKERRQ(ierr);
ierr = MatAssemblyEnd( stokes_A, MAT_FINAL_ASSEMBLY );CHKERRQ(ierr);
x[0]=u;
x[1]=p;
ierr = VecCreateNest(PetscObjectComm((PetscObject) u), 2, NULL, x, &stokes_x);CHKERRQ(ierr);
ierr = VecAssemblyBegin( stokes_x );CHKERRQ(ierr);
ierr = VecAssemblyEnd( stokes_x);CHKERRQ(ierr);
b[0]=f;
b[1]=h;
ierr = VecCreateNest(PetscObjectComm((PetscObject) f), 2, NULL, b, &stokes_b);CHKERRQ(ierr);
ierr = VecAssemblyBegin( stokes_b );CHKERRQ(ierr);
ierr = VecAssemblyEnd( stokes_b);CHKERRQ(ierr);
/* if( approxS ) { */
/* a[0][0]=K; a[0][1]=G; */
/* a[1][0]=NULL; a[1][1]=approxS; */
/* ierr = MatCreateNest(PetscObjectComm((PetscObject) K), 2, NULL, 2, NULL, (Mat *)a, &stokes_P);CHKERRQ(ierr); */
/* ierr = MatAssemblyBegin( stokes_P, MAT_FINAL_ASSEMBLY );CHKERRQ(ierr); */
/* ierr = MatAssemblyEnd( stokes_P, MAT_FINAL_ASSEMBLY );CHKERRQ(ierr); */
/* } */
/* else { */
stokes_P = stokes_A;
/* } */
/* probably should make a Destroy function for these two */
/* Update options from file and/or string here so we can change things on the fly */
//PetscOptionsInsertFile(PETSC_COMM_WORLD, Solver->optionsFile, PETSC_FALSE);
//PetscOptionsInsertString(Solver->optionsString);
ierr = KSPCreate( PETSC_COMM_WORLD, &stokes_ksp );CHKERRQ(ierr);
Stg_KSPSetOperators( stokes_ksp, stokes_A, stokes_P, SAME_NONZERO_PATTERN );
ierr = KSPSetType( stokes_ksp, "bsscr" );/* i.e. making this the default solver : calls KSPCreate_XXX */CHKERRQ(ierr);
ierr = KSPGetPC( stokes_ksp, &stokes_pc );CHKERRQ(ierr);
ierr = PCSetType( stokes_pc, PCNONE );CHKERRQ(ierr);
ierr = KSPSetInitialGuessNonzero( stokes_ksp, PETSC_TRUE );CHKERRQ(ierr);
ierr = KSPSetFromOptions( stokes_ksp );CHKERRQ(ierr);
/*
Doing this so the KSP Solver has access to the StgFEM Multigrid struct (PETScMGSolver).
As well as any custom stuff on the Stokes_SLE struct
*/
if( stokes_ksp->data ){/* then ksp->data has been created in a KSpSetUp_XXX function */
/* testing for our KSP types that need the data that is on Solver... */
/* for the moment then, this function not completely agnostic about our KSPs */
//if(!strcmp("bsscr",stokes_ksp->type_name)){/* if is bsscr then set up the data on the ksp */
flg=PETSC_FALSE;
PetscOptionsHasName(PETSC_NULL,"-use_petsc_ksp",&flg);
if (!flg) {
((KSP_COMMON*)(stokes_ksp->data))->st_sle = Solver->st_sle;
((KSP_COMMON*)(stokes_ksp->data))->mg = Solver->mg;
((KSP_COMMON*)(stokes_ksp->data))->DIsSym = Solver->DIsSym;
((KSP_COMMON*)(stokes_ksp->data))->preconditioner = Solver->preconditioner;
((KSP_COMMON*)(stokes_ksp->data))->solver = Solver;
}
}
ierr = KSPSolve( stokes_ksp, stokes_b, stokes_x );CHKERRQ(ierr);
Stg_KSPDestroy(&stokes_ksp );
//if( ((StokesBlockKSPInterface*)stokesSLE->solver)->preconditioner )
if(stokes_P != stokes_A) { Stg_MatDestroy(&stokes_P ); }
Stg_MatDestroy(&stokes_A );
Stg_VecDestroy(&stokes_x);
Stg_VecDestroy(&stokes_b);
if(!D){ Stg_MatDestroy(&Gt); }
if(C && (stokesSLE->cStiffMat->matrix != C) ){ Stg_MatDestroy(&C); }
PetscFunctionReturn(0);
}
int main(int argc, char *argv[])
{
PetscErrorCode ierr;
IS is0a,is0b,is0,is1,isl0a,isl0b,isl0,isl1;
Mat A,Aexplicit;
PetscBool usenest;
PetscMPIInt rank,size;
PetscInt i,j;
PetscInitialize(&argc,&argv,PETSC_NULL,help);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
{
const PetscInt ix0a[] = {rank*2+0},ix0b[] = {rank*2+1},ix0[] = {rank*3+0,rank*3+1},ix1[] = {rank*3+2};
ierr = ISCreateGeneral(PETSC_COMM_WORLD,1,ix0a,PETSC_COPY_VALUES,&is0a);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_WORLD,1,ix0b,PETSC_COPY_VALUES,&is0b);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_WORLD,2,ix0,PETSC_COPY_VALUES,&is0);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_WORLD,1,ix1,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr);
}
{
ierr = ISCreateStride(PETSC_COMM_SELF,6,0,1,&isl0);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,3,0,1,&isl0a);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,3,3,1,&isl0b);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,3,6,1,&isl1);CHKERRQ(ierr);
}
usenest = PETSC_FALSE;
ierr = PetscOptionsGetBool(PETSC_NULL,"-nest",&usenest,PETSC_NULL);CHKERRQ(ierr);
if (usenest) {
ISLocalToGlobalMapping l2g;
const PetscInt l2gind[3] = {(rank-1+size)%size,rank,(rank+1)%size};
Mat B[9];
ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_WORLD,3,l2gind,PETSC_COPY_VALUES,&l2g);CHKERRQ(ierr);
for (i=0; i<9; i++) {
ierr = MatCreateAIJ(PETSC_COMM_WORLD,1,1,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,PETSC_NULL,PETSC_DECIDE,PETSC_NULL,&B[i]);CHKERRQ(ierr);
ierr = MatSetUp(B[i]);CHKERRQ(ierr);
ierr = MatSetLocalToGlobalMapping(B[i],l2g,l2g);CHKERRQ(ierr);
}
{
const IS isx[] = {is0a,is0b};
const Mat Bx00[] = {B[0],B[1],B[3],B[4]},Bx01[] = {B[2],B[5]},Bx10[] = {B[6],B[7]};
Mat B00,B01,B10;
ierr = MatCreateNest(PETSC_COMM_WORLD,2,isx,2,isx,Bx00,&B00);CHKERRQ(ierr);
ierr = MatSetUp(B00);CHKERRQ(ierr);
ierr = MatCreateNest(PETSC_COMM_WORLD,2,isx,1,PETSC_NULL,Bx01,&B01);CHKERRQ(ierr);
ierr = MatSetUp(B01);CHKERRQ(ierr);
ierr = MatCreateNest(PETSC_COMM_WORLD,1,PETSC_NULL,2,isx,Bx10,&B10);CHKERRQ(ierr);
ierr = MatSetUp(B10);CHKERRQ(ierr);
{
Mat By[] = {B00,B01,B10,B[8]};
IS isy[] = {is0,is1};
ierr = MatCreateNest(PETSC_COMM_WORLD,2,isy,2,isy,By,&A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
}
ierr = MatDestroy(&B00);CHKERRQ(ierr);
ierr = MatDestroy(&B01);CHKERRQ(ierr);
ierr = MatDestroy(&B10);CHKERRQ(ierr);
}
for (i=0; i<9; i++) {ierr = MatDestroy(&B[i]);CHKERRQ(ierr);}
ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
} else {
ISLocalToGlobalMapping l2g;
PetscInt l2gind[9];
for (i=0; i<3; i++) for (j=0; j<3; j++) l2gind[3*i+j] = ((rank-1+j+size) % size)*3 + i;
ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_WORLD,9,l2gind,PETSC_COPY_VALUES,&l2g);CHKERRQ(ierr);
ierr = MatCreateAIJ(PETSC_COMM_WORLD,3,3,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,PETSC_NULL,PETSC_DECIDE,PETSC_NULL,&A);CHKERRQ(ierr);
ierr = MatSetLocalToGlobalMapping(A,l2g,l2g);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
}
{
Mat A00,A11,A0a0a,A0a0b;
ierr = MatGetLocalSubMatrix(A,isl0,isl0,&A00);CHKERRQ(ierr);
ierr = MatGetLocalSubMatrix(A,isl1,isl1,&A11);CHKERRQ(ierr);
ierr = MatGetLocalSubMatrix(A00,isl0a,isl0a,&A0a0a);CHKERRQ(ierr);
ierr = MatGetLocalSubMatrix(A00,isl0a,isl0b,&A0a0b);CHKERRQ(ierr);
ierr = MatSetValueLocal(A0a0a,0,0,100*rank+1,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValueLocal(A0a0a,0,1,100*rank+2,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValueLocal(A0a0a,2,2,100*rank+9,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValueLocal(A0a0b,1,1,100*rank+50+5,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValueLocal(A11,0,0,1000*(rank+1)+1,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValueLocal(A11,1,2,1000*(rank+1)+6,ADD_VALUES);CHKERRQ(ierr);
ierr = MatRestoreLocalSubMatrix(A00,isl0a,isl0a,&A0a0a);CHKERRQ(ierr);
ierr = MatRestoreLocalSubMatrix(A00,isl0a,isl0b,&A0a0b);CHKERRQ(ierr);
ierr = MatRestoreLocalSubMatrix(A,isl0,isl0,&A00);CHKERRQ(ierr);
ierr = MatRestoreLocalSubMatrix(A,isl1,isl1,&A11);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatComputeExplicitOperator(A,&Aexplicit);CHKERRQ(ierr);
ierr = MatView(Aexplicit,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&Aexplicit);CHKERRQ(ierr);
ierr = ISDestroy(&is0a);CHKERRQ(ierr);
ierr = ISDestroy(&is0b);CHKERRQ(ierr);
ierr = ISDestroy(&is0);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
ierr = ISDestroy(&isl0a);CHKERRQ(ierr);
ierr = ISDestroy(&isl0b);CHKERRQ(ierr);
ierr = ISDestroy(&isl0);CHKERRQ(ierr);
ierr = ISDestroy(&isl1);CHKERRQ(ierr);
PetscFinalize();
return 0;
}
static int block_system(void)
{
SNES snes; /* nonlinear solver context */
KSP ksp; /* linear solver context */
PC pc; /* preconditioner context */
Vec x,r; /* solution, residual vectors */
Mat J; /* Jacobian matrix */
PetscErrorCode ierr;
PetscInt its;
PetscScalar pfive = .5;
PetscBool flg;
Mat j11, j12, j21, j22;
Vec x1, x2, r1, r2;
Vec bv;
Vec bx[2];
Mat bA[2][2];
PetscFunctionBegin;
PetscPrintf( PETSC_COMM_WORLD, "\n\n========================= Block system =========================\n\n" );
ierr = SNESCreate(PETSC_COMM_WORLD,&snes);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create matrix and vector data structures; set corresponding routines
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create sub vectors for solution and nonlinear function
*/
ierr = VecCreateSeq(PETSC_COMM_SELF,1,&x1);
CHKERRQ(ierr);
ierr = VecDuplicate(x1,&r1);
CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,1,&x2);
CHKERRQ(ierr);
ierr = VecDuplicate(x2,&r2);
CHKERRQ(ierr);
/*
Create the block vectors
*/
bx[0] = x1;
bx[1] = x2;
ierr = VecCreateNest(PETSC_COMM_WORLD,2,PETSC_NULL,bx,&x);
CHKERRQ(ierr);
ierr = VecAssemblyBegin(x);
CHKERRQ(ierr);
ierr = VecAssemblyEnd(x);
CHKERRQ(ierr);
ierr = VecDestroy(&x1);
CHKERRQ(ierr);
ierr = VecDestroy(&x2);
CHKERRQ(ierr);
bx[0] = r1;
bx[1] = r2;
ierr = VecCreateNest(PETSC_COMM_WORLD,2,PETSC_NULL,bx,&r);
CHKERRQ(ierr);
ierr = VecDestroy(&r1);
CHKERRQ(ierr);
ierr = VecDestroy(&r2);
CHKERRQ(ierr);
ierr = VecAssemblyBegin(r);
CHKERRQ(ierr);
ierr = VecAssemblyEnd(r);
CHKERRQ(ierr);
/*
Create sub Jacobian matrix data structure
*/
ierr = MatCreate( PETSC_COMM_WORLD, &j11 );
CHKERRQ(ierr);
ierr = MatSetSizes( j11, 1, 1, 1, 1 );
CHKERRQ(ierr);
ierr = MatSetType( j11, MATSEQAIJ );
CHKERRQ(ierr);
ierr = MatSetUp(j11);
CHKERRQ(ierr);
ierr = MatCreate( PETSC_COMM_WORLD, &j12 );
CHKERRQ(ierr);
ierr = MatSetSizes( j12, 1, 1, 1, 1 );
CHKERRQ(ierr);
ierr = MatSetType( j12, MATSEQAIJ );
CHKERRQ(ierr);
ierr = MatSetUp(j12);
CHKERRQ(ierr);
ierr = MatCreate( PETSC_COMM_WORLD, &j21 );
CHKERRQ(ierr);
ierr = MatSetSizes( j21, 1, 1, 1, 1 );
CHKERRQ(ierr);
ierr = MatSetType( j21, MATSEQAIJ );
CHKERRQ(ierr);
ierr = MatSetUp(j21);
CHKERRQ(ierr);
ierr = MatCreate( PETSC_COMM_WORLD, &j22 );
CHKERRQ(ierr);
ierr = MatSetSizes( j22, PETSC_DECIDE, PETSC_DECIDE, 1, 1 );
CHKERRQ(ierr);
ierr = MatSetType( j22, MATSEQAIJ );
CHKERRQ(ierr);
ierr = MatSetUp(j22);
CHKERRQ(ierr);
/*
Create block Jacobian matrix data structure
*/
bA[0][0] = j11;
bA[0][1] = j12;
bA[1][0] = j21;
bA[1][1] = j22;
ierr = MatCreateNest(PETSC_COMM_WORLD,2,PETSC_NULL,2,PETSC_NULL,&bA[0][0],&J);
CHKERRQ(ierr);
ierr = MatSetUp(J);
CHKERRQ(ierr);
ierr = MatNestSetVecType(J,VECNEST);
CHKERRQ(ierr);
ierr = MatDestroy(&j11);
CHKERRQ(ierr);
ierr = MatDestroy(&j12);
CHKERRQ(ierr);
ierr = MatDestroy(&j21);
CHKERRQ(ierr);
ierr = MatDestroy(&j22);
CHKERRQ(ierr);
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL,"-hard",&flg);
CHKERRQ(ierr);
if (!flg) {
/*
Set function evaluation routine and vector.
*/
ierr = SNESSetFunction(snes,r,FormFunction1_block,PETSC_NULL);
CHKERRQ(ierr);
/*
Set Jacobian matrix data structure and Jacobian evaluation routine
*/
ierr = SNESSetJacobian(snes,J,J,FormJacobian1_block,PETSC_NULL);
CHKERRQ(ierr);
} else {
ierr = SNESSetFunction(snes,r,FormFunction2_block,PETSC_NULL);
CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,FormJacobian2_block,PETSC_NULL);
CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Customize nonlinear solver; set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Set linear solver defaults for this problem. By extracting the
KSP, KSP, and PC contexts from the SNES context, we can then
directly call any KSP, KSP, and PC routines to set various options.
*/
ierr = SNESGetKSP(snes,&ksp);
CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);
CHKERRQ(ierr);
ierr = PCSetType(pc,PCNONE);
CHKERRQ(ierr);
ierr = KSPSetTolerances(ksp,1.e-4,PETSC_DEFAULT,PETSC_DEFAULT,20);
CHKERRQ(ierr);
/*
Set SNES/KSP/KSP/PC runtime options, e.g.,
-snes_view -snes_monitor -ksp_type <ksp> -pc_type <pc>
These options will override those specified above as long as
SNESSetFromOptions() is called _after_ any other customization
routines.
*/
ierr = SNESSetFromOptions(snes);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Evaluate initial guess; then solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
if (!flg) {
ierr = VecSet(x,pfive);
CHKERRQ(ierr);
} else {
Vec *vecs;
ierr = VecNestGetSubVecs( x, PETSC_NULL, &vecs );
CHKERRQ(ierr);
bv = vecs[0];
// ierr = VecBlockGetSubVec( x, 0, &bv );CHKERRQ(ierr);
ierr = VecSetValue( bv, 0, 2.0, INSERT_VALUES );
CHKERRQ(ierr); /* xx[0] = 2.0; */
ierr = VecAssemblyBegin(bv);
CHKERRQ(ierr);
ierr = VecAssemblyEnd(bv);
CHKERRQ(ierr);
// ierr = VecBlockGetSubVec( x, 1, &bv );CHKERRQ(ierr);
bv = vecs[1];
ierr = VecSetValue( bv, 0, 3.0, INSERT_VALUES );
CHKERRQ(ierr); /* xx[1] = 3.0; */
ierr = VecAssemblyBegin(bv);
CHKERRQ(ierr);
ierr = VecAssemblyEnd(bv);
CHKERRQ(ierr);
}
/*
Note: The user should initialize the vector, x, with the initial guess
for the nonlinear solver prior to calling SNESSolve(). In particular,
to employ an initial guess of zero, the user should explicitly set
this vector to zero by calling VecSet().
*/
ierr = SNESSolve(snes,PETSC_NULL,x);
CHKERRQ(ierr);
ierr = SNESGetIterationNumber(snes,&its);
CHKERRQ(ierr);
if (flg) {
Vec f;
ierr = VecView(x,PETSC_VIEWER_STDOUT_WORLD);
CHKERRQ(ierr);
ierr = SNESGetFunction(snes,&f,0,0);
CHKERRQ(ierr);
ierr = VecView(r,PETSC_VIEWER_STDOUT_WORLD);
CHKERRQ(ierr);
}
ierr = PetscPrintf(PETSC_COMM_SELF,"number of SNES iterations = %D\n\n",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(&r);
CHKERRQ(ierr);
ierr = MatDestroy(&J);
CHKERRQ(ierr);
ierr = SNESDestroy(&snes);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
const PetscScalar xvals[] = {11,13},yvals[] = {17,19},zvals[] = {23,29};
const PetscInt inds[] = {0,1};
PetscScalar avals[] = {2,3,5,7};
Mat A,S,D[4],N;
Vec X,Y,Z;
User user;
PetscInt i;
PetscErrorCode ierr;
PetscInitialize(&argc,&args,(char*)0,help);
ierr = MatCreateSeqAIJ(PETSC_COMM_WORLD,2,2,2,NULL,&A);
CHKERRQ(ierr);
ierr = MatSetUp(A);
CHKERRQ(ierr);
ierr = MatSetValues(A,2,inds,2,inds,avals,INSERT_VALUES);
CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_WORLD,2,&X);
CHKERRQ(ierr);
ierr = VecDuplicate(X,&Y);
CHKERRQ(ierr);
ierr = VecDuplicate(X,&Z);
CHKERRQ(ierr);
ierr = VecSetValues(X,2,inds,xvals,INSERT_VALUES);
CHKERRQ(ierr);
ierr = VecSetValues(Y,2,inds,yvals,INSERT_VALUES);
CHKERRQ(ierr);
ierr = VecSetValues(Z,2,inds,zvals,INSERT_VALUES);
CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = VecAssemblyBegin(X);
CHKERRQ(ierr);
ierr = VecAssemblyBegin(Y);
CHKERRQ(ierr);
ierr = VecAssemblyBegin(Z);
CHKERRQ(ierr);
ierr = VecAssemblyEnd(X);
CHKERRQ(ierr);
ierr = VecAssemblyEnd(Y);
CHKERRQ(ierr);
ierr = VecAssemblyEnd(Z);
CHKERRQ(ierr);
ierr = PetscNew(struct _n_User,&user);
CHKERRQ(ierr);
user->B = A;
ierr = MatCreateShell(PETSC_COMM_WORLD,2,2,2,2,user,&S);
CHKERRQ(ierr);
ierr = MatSetUp(S);
CHKERRQ(ierr);
ierr = MatShellSetOperation(S,MATOP_MULT,(void (*)(void))MatMult_User);
CHKERRQ(ierr);
ierr = MatShellSetOperation(S,MATOP_MULT_TRANSPOSE,(void (*)(void))MatMultTranspose_User);
CHKERRQ(ierr);
ierr = MatShellSetOperation(S,MATOP_GET_DIAGONAL,(void (*)(void))MatGetDiagonal_User);
CHKERRQ(ierr);
for (i=0; i<4; i++) {
ierr = MatCreateSeqDense(PETSC_COMM_WORLD,1,1,&avals[i],&D[i]);
CHKERRQ(ierr);
}
ierr = MatCreateNest(PETSC_COMM_WORLD,2,NULL,2,NULL,D,&N);
CHKERRQ(ierr);
ierr = MatSetUp(N);
CHKERRQ(ierr);
ierr = TestMatrix(S,X,Y,Z);
CHKERRQ(ierr);
ierr = TestMatrix(A,X,Y,Z);
CHKERRQ(ierr);
ierr = TestMatrix(N,X,Y,Z);
CHKERRQ(ierr);
for (i=0; i<4; i++) {
ierr = MatDestroy(&D[i]);
CHKERRQ(ierr);
}
ierr = MatDestroy(&A);
CHKERRQ(ierr);
ierr = MatDestroy(&S);
CHKERRQ(ierr);
ierr = MatDestroy(&N);
CHKERRQ(ierr);
ierr = VecDestroy(&X);
CHKERRQ(ierr);
ierr = VecDestroy(&Y);
CHKERRQ(ierr);
ierr = VecDestroy(&Z);
CHKERRQ(ierr);
ierr = PetscFree(user);
CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
void PETSC_STDCALL matcreatenest_(MPI_Fint * comm,PetscInt *nr, IS is_row[],PetscInt *nc, IS is_col[], Mat a[],Mat *B, int *__ierr ){
*__ierr = MatCreateNest(
MPI_Comm_f2c( *(comm) ),*nr,is_row,*nc,is_col,a,B);
}