PetscErrorCode DMCreateFieldIS_Composite(DM dm, PetscInt *numFields,char ***fieldNames, IS **fields)
{
PetscInt nDM;
DM *dms;
PetscInt i;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = DMCompositeGetNumberDM(dm, &nDM);CHKERRQ(ierr);
if (numFields) {*numFields = nDM;}
ierr = DMCompositeGetGlobalISs(dm, fields);CHKERRQ(ierr);
if (fieldNames) {
ierr = PetscMalloc(nDM*sizeof(DM), &dms);CHKERRQ(ierr);
ierr = PetscMalloc(nDM*sizeof(const char *), fieldNames);CHKERRQ(ierr);
ierr = DMCompositeGetEntriesArray(dm, dms);CHKERRQ(ierr);
for (i=0; i<nDM; i++) {
char buf[256];
const char *splitname;
/* Split naming precedence: object name, prefix, number */
splitname = ((PetscObject) dm)->name;
if (!splitname) {
ierr = PetscObjectGetOptionsPrefix((PetscObject)dms[i],&splitname);CHKERRQ(ierr);
if (splitname) {
size_t len;
ierr = PetscStrncpy(buf,splitname,sizeof(buf));CHKERRQ(ierr);
buf[sizeof(buf) - 1] = 0;
ierr = PetscStrlen(buf,&len);CHKERRQ(ierr);
if (buf[len-1] == '_') buf[len-1] = 0; /* Remove trailing underscore if it was used */
splitname = buf;
}
}
if (!splitname) {
ierr = PetscSNPrintf(buf,sizeof(buf),"%D",i);CHKERRQ(ierr);
splitname = buf;
}
ierr = PetscStrallocpy(splitname,&(*fieldNames)[i]);CHKERRQ(ierr);
}
ierr = PetscFree(dms);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);
}
static PetscErrorCode SNESMultiblockSetDefaults(SNES snes)
{
SNES_Multiblock *mb = (SNES_Multiblock *) snes->data;
BlockDesc blocks = mb->blocks;
PetscInt i;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!blocks) {
if (snes->dm) {
PetscBool dmcomposite;
ierr = PetscObjectTypeCompare((PetscObject) snes->dm, DMCOMPOSITE, &dmcomposite);CHKERRQ(ierr);
if (dmcomposite) {
PetscInt nDM;
IS *fields;
ierr = PetscInfo(snes,"Setting up physics based multiblock solver using the embedded DM\n");CHKERRQ(ierr);
ierr = DMCompositeGetNumberDM(snes->dm, &nDM);CHKERRQ(ierr);
ierr = DMCompositeGetGlobalISs(snes->dm, &fields);CHKERRQ(ierr);
for (i = 0; i < nDM; ++i) {
char name[8];
ierr = PetscSNPrintf(name, sizeof(name), "%D", i);CHKERRQ(ierr);
ierr = SNESMultiblockSetIS(snes, name, fields[i]);CHKERRQ(ierr);
ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
}
ierr = PetscFree(fields);CHKERRQ(ierr);
}
} else {
PetscBool flg = PETSC_FALSE;
PetscBool stokes = PETSC_FALSE;
if (mb->bs <= 0) {
if (snes->jacobian_pre) {
ierr = MatGetBlockSize(snes->jacobian_pre, &mb->bs);CHKERRQ(ierr);
} else {
mb->bs = 1;
}
}
ierr = PetscOptionsGetBool(((PetscObject) snes)->prefix, "-snes_multiblock_default", &flg, PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(((PetscObject) snes)->prefix, "-snes_multiblock_detect_saddle_point", &stokes, PETSC_NULL);CHKERRQ(ierr);
if (stokes) {
IS zerodiags, rest;
PetscInt nmin, nmax;
ierr = MatGetOwnershipRange(snes->jacobian_pre, &nmin, &nmax);CHKERRQ(ierr);
ierr = MatFindZeroDiagonals(snes->jacobian_pre, &zerodiags);CHKERRQ(ierr);
ierr = ISComplement(zerodiags, nmin, nmax, &rest);CHKERRQ(ierr);
ierr = SNESMultiblockSetIS(snes, "0", rest);CHKERRQ(ierr);
ierr = SNESMultiblockSetIS(snes, "1", zerodiags);CHKERRQ(ierr);
ierr = ISDestroy(&zerodiags);CHKERRQ(ierr);
ierr = ISDestroy(&rest);CHKERRQ(ierr);
} else {
if (!flg) {
/* Allow user to set fields from command line, if bs was known at the time of SNESSetFromOptions_Multiblock()
then it is set there. This is not ideal because we should only have options set in XXSetFromOptions(). */
ierr = SNESMultiblockSetFieldsRuntime_Private(snes);CHKERRQ(ierr);
if (mb->defined) {ierr = PetscInfo(snes, "Blocks defined using the options database\n");CHKERRQ(ierr);}
}
if (flg || !mb->defined) {
ierr = PetscInfo(snes, "Using default splitting of fields\n");CHKERRQ(ierr);
for (i = 0; i < mb->bs; ++i) {
char name[8];
ierr = PetscSNPrintf(name, sizeof(name), "%D", i);CHKERRQ(ierr);
ierr = SNESMultiblockSetFields(snes, name, 1, &i);CHKERRQ(ierr);
}
mb->defaultblocks = PETSC_TRUE;
}
}
}
} else if (mb->numBlocks == 1) {
if (blocks->is) {
IS is2;
PetscInt nmin, nmax;
ierr = MatGetOwnershipRange(snes->jacobian_pre, &nmin, &nmax);CHKERRQ(ierr);
ierr = ISComplement(blocks->is, nmin, nmax, &is2);CHKERRQ(ierr);
ierr = SNESMultiblockSetIS(snes, "1", is2);CHKERRQ(ierr);
ierr = ISDestroy(&is2);CHKERRQ(ierr);
} else {
SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "Must provide at least two sets of fields to SNES multiblock");
}
}
if (mb->numBlocks < 2) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unhandled case, must have at least two blocks");
PetscFunctionReturn(0);
}
int main(int argc, char *argv[])
{
PetscErrorCode ierr;
DM dau,dak,pack;
const PetscInt *lxu;
PetscInt *lxk,m,sizes;
User user;
SNES snes;
Vec X,F,Xu,Xk,Fu,Fk;
Mat B;
IS *isg;
PetscBool view_draw,pass_dm;
PetscInitialize(&argc,&argv,0,help);
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,-10,1,1,NULL,&dau);CHKERRQ(ierr);
ierr = DMSetOptionsPrefix(dau,"u_");CHKERRQ(ierr);
ierr = DMSetFromOptions(dau);CHKERRQ(ierr);
ierr = DMDAGetOwnershipRanges(dau,&lxu,0,0);CHKERRQ(ierr);
ierr = DMDAGetInfo(dau,0, &m,0,0, &sizes,0,0, 0,0,0,0,0,0);CHKERRQ(ierr);
ierr = PetscMalloc1(sizes,&lxk);CHKERRQ(ierr);
ierr = PetscMemcpy(lxk,lxu,sizes*sizeof(*lxk));CHKERRQ(ierr);
lxk[0]--;
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,m-1,1,1,lxk,&dak);CHKERRQ(ierr);
ierr = DMSetOptionsPrefix(dak,"k_");CHKERRQ(ierr);
ierr = DMSetFromOptions(dak);CHKERRQ(ierr);
ierr = PetscFree(lxk);CHKERRQ(ierr);
ierr = DMCompositeCreate(PETSC_COMM_WORLD,&pack);CHKERRQ(ierr);
ierr = DMSetOptionsPrefix(pack,"pack_");CHKERRQ(ierr);
ierr = DMCompositeAddDM(pack,dau);CHKERRQ(ierr);
ierr = DMCompositeAddDM(pack,dak);CHKERRQ(ierr);
ierr = DMDASetFieldName(dau,0,"u");CHKERRQ(ierr);
ierr = DMDASetFieldName(dak,0,"k");CHKERRQ(ierr);
ierr = DMSetFromOptions(pack);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(pack,&X);CHKERRQ(ierr);
ierr = VecDuplicate(X,&F);CHKERRQ(ierr);
ierr = PetscNew(&user);CHKERRQ(ierr);
user->pack = pack;
ierr = DMCompositeGetGlobalISs(pack,&isg);CHKERRQ(ierr);
ierr = DMCompositeGetLocalVectors(pack,&user->Uloc,&user->Kloc);CHKERRQ(ierr);
ierr = DMCompositeScatter(pack,X,user->Uloc,user->Kloc);CHKERRQ(ierr);
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Coupled problem options","SNES");CHKERRQ(ierr);
{
user->ptype = 0; view_draw = PETSC_FALSE; pass_dm = PETSC_TRUE;
ierr = PetscOptionsInt("-problem_type","0: solve for u only, 1: solve for k only, 2: solve for both",0,user->ptype,&user->ptype,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-view_draw","Draw the final coupled solution regardless of whether only one physics was solved",0,view_draw,&view_draw,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-pass_dm","Pass the packed DM to SNES to use when determining splits and forward into splits",0,pass_dm,&pass_dm,NULL);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = FormInitial_Coupled(user,X);CHKERRQ(ierr);
ierr = SNESCreate(PETSC_COMM_WORLD,&snes);CHKERRQ(ierr);
switch (user->ptype) {
case 0:
ierr = DMCompositeGetAccess(pack,X,&Xu,0);CHKERRQ(ierr);
ierr = DMCompositeGetAccess(pack,F,&Fu,0);CHKERRQ(ierr);
ierr = DMCreateMatrix(dau,&B);CHKERRQ(ierr);
ierr = SNESSetFunction(snes,Fu,FormFunction_All,user);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,B,B,FormJacobian_All,user);CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
ierr = SNESSetDM(snes,dau);CHKERRQ(ierr);
ierr = SNESSolve(snes,NULL,Xu);CHKERRQ(ierr);
ierr = DMCompositeRestoreAccess(pack,X,&Xu,0);CHKERRQ(ierr);
ierr = DMCompositeRestoreAccess(pack,F,&Fu,0);CHKERRQ(ierr);
break;
case 1:
ierr = DMCompositeGetAccess(pack,X,0,&Xk);CHKERRQ(ierr);
ierr = DMCompositeGetAccess(pack,F,0,&Fk);CHKERRQ(ierr);
ierr = DMCreateMatrix(dak,&B);CHKERRQ(ierr);
ierr = SNESSetFunction(snes,Fk,FormFunction_All,user);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,B,B,FormJacobian_All,user);CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
ierr = SNESSetDM(snes,dak);CHKERRQ(ierr);
ierr = SNESSolve(snes,NULL,Xk);CHKERRQ(ierr);
ierr = DMCompositeRestoreAccess(pack,X,0,&Xk);CHKERRQ(ierr);
ierr = DMCompositeRestoreAccess(pack,F,0,&Fk);CHKERRQ(ierr);
break;
case 2:
ierr = DMCreateMatrix(pack,&B);CHKERRQ(ierr);
/* This example does not correctly allocate off-diagonal blocks. These options allows new nonzeros (slow). */
ierr = MatSetOption(B,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
ierr = SNESSetFunction(snes,F,FormFunction_All,user);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,B,B,FormJacobian_All,user);CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
if (!pass_dm) { /* Manually provide index sets and names for the splits */
KSP ksp;
PC pc;
ierr = SNESGetKSP(snes,&ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCFieldSplitSetIS(pc,"u",isg[0]);CHKERRQ(ierr);
ierr = PCFieldSplitSetIS(pc,"k",isg[1]);CHKERRQ(ierr);
} else {
/* The same names come from the options prefix for dau and dak. This option can support geometric multigrid inside
* of splits, but it requires using a DM (perhaps your own implementation). */
ierr = SNESSetDM(snes,pack);CHKERRQ(ierr);
}
ierr = SNESSolve(snes,NULL,X);CHKERRQ(ierr);
break;
}
if (view_draw) {ierr = VecView(X,PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);}
if (0) {
PetscInt col = 0;
PetscBool mult_dup = PETSC_FALSE,view_dup = PETSC_FALSE;
Mat D;
Vec Y;
ierr = PetscOptionsGetInt(0,"-col",&col,0);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(0,"-mult_dup",&mult_dup,0);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(0,"-view_dup",&view_dup,0);CHKERRQ(ierr);
ierr = VecDuplicate(X,&Y);CHKERRQ(ierr);
/* ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); */
/* ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); */
ierr = MatConvert(B,MATAIJ,MAT_INITIAL_MATRIX,&D);CHKERRQ(ierr);
ierr = VecZeroEntries(X);CHKERRQ(ierr);
ierr = VecSetValue(X,col,1.0,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(X);CHKERRQ(ierr);
ierr = VecAssemblyEnd(X);CHKERRQ(ierr);
ierr = MatMult(mult_dup ? D : B,X,Y);CHKERRQ(ierr);
ierr = MatView(view_dup ? D : B,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* ierr = VecView(X,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); */
ierr = VecView(Y,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatDestroy(&D);CHKERRQ(ierr);
ierr = VecDestroy(&Y);CHKERRQ(ierr);
}
ierr = DMCompositeRestoreLocalVectors(pack,&user->Uloc,&user->Kloc);CHKERRQ(ierr);
ierr = PetscFree(user);CHKERRQ(ierr);
ierr = ISDestroy(&isg[0]);CHKERRQ(ierr);
ierr = ISDestroy(&isg[1]);CHKERRQ(ierr);
ierr = PetscFree(isg);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = VecDestroy(&F);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = DMDestroy(&dau);CHKERRQ(ierr);
ierr = DMDestroy(&dak);CHKERRQ(ierr);
ierr = DMDestroy(&pack);CHKERRQ(ierr);
ierr = SNESDestroy(&snes);CHKERRQ(ierr);
PetscFinalize();
return 0;
}
