/*@ MatSchurComplementComputeExplicitOperator - Compute the Schur complement matrix explicitly Collective on Mat Input Parameter: . M - the matrix obtained with MatCreateSchurComplement() Output Parameter: . S - the Schur complement matrix Note: This can be expensive, so it is mainly for testing Level: advanced .seealso: MatCreateSchurComplement(), MatSchurComplementUpdate() @*/ PetscErrorCode MatSchurComplementComputeExplicitOperator(Mat M, Mat *S) { Mat B, C, D; KSP ksp; PC pc; PetscBool isLU, isILU; PetscReal fill = 2.0; PetscErrorCode ierr; PetscFunctionBegin; ierr = MatSchurComplementGetSubMatrices(M, NULL, NULL, &B, &C, &D);CHKERRQ(ierr); ierr = MatSchurComplementGetKSP(M, &ksp);CHKERRQ(ierr); ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject) pc, PCLU, &isLU);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject) pc, PCILU, &isILU);CHKERRQ(ierr); if (isLU || isILU) { Mat fact, Bd, AinvB, AinvBd; PetscReal eps = 1.0e-10; /* This can be sped up for banded LU */ ierr = KSPSetUp(ksp);CHKERRQ(ierr); ierr = PCFactorGetMatrix(pc, &fact);CHKERRQ(ierr); ierr = MatConvert(B, MATDENSE, MAT_INITIAL_MATRIX, &Bd);CHKERRQ(ierr); ierr = MatDuplicate(Bd, MAT_DO_NOT_COPY_VALUES, &AinvBd);CHKERRQ(ierr); ierr = MatMatSolve(fact, Bd, AinvBd);CHKERRQ(ierr); ierr = MatDestroy(&Bd);CHKERRQ(ierr); ierr = MatChop(AinvBd, eps);CHKERRQ(ierr); ierr = MatConvert(AinvBd, MATAIJ, MAT_INITIAL_MATRIX, &AinvB);CHKERRQ(ierr); ierr = MatDestroy(&AinvBd);CHKERRQ(ierr); ierr = MatMatMult(C, AinvB, MAT_INITIAL_MATRIX, fill, S);CHKERRQ(ierr); ierr = MatDestroy(&AinvB);CHKERRQ(ierr); } else { Mat Ainvd, Ainv; ierr = PCComputeExplicitOperator(pc, &Ainvd);CHKERRQ(ierr); ierr = MatConvert(Ainvd, MATAIJ, MAT_INITIAL_MATRIX, &Ainv);CHKERRQ(ierr); ierr = MatDestroy(&Ainvd);CHKERRQ(ierr); #if 0 /* Symmetric version */ ierr = MatPtAP(Ainv, B, MAT_INITIAL_MATRIX, fill, S);CHKERRQ(ierr); #else /* Nonsymmetric version */ ierr = MatMatMatMult(C, Ainv, B, MAT_INITIAL_MATRIX, fill, S);CHKERRQ(ierr); #endif ierr = MatDestroy(&Ainv);CHKERRQ(ierr); } ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr); ierr = MatView(*S, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); if (D) { MatInfo info; ierr = MatGetInfo(D, MAT_GLOBAL_SUM, &info);CHKERRQ(ierr); if (info.nz_used) SETERRQ(PetscObjectComm((PetscObject) M), PETSC_ERR_SUP, "Not yet implemented"); } PetscFunctionReturn(0); }
/*@ MatSchurComplementComputeExplicitOperator - Compute the Schur complement matrix explicitly Collective on Mat Input Parameter: . M - the matrix obtained with MatCreateSchurComplement() Output Parameter: . S - the Schur complement matrix Note: This can be expensive, so it is mainly for testing Level: advanced .seealso: MatCreateSchurComplement(), MatSchurComplementUpdate() @*/ PetscErrorCode MatSchurComplementComputeExplicitOperator(Mat M, Mat *S) { Mat B, C, D; KSP ksp; PC pc; PetscBool isLU, isILU; PetscReal fill = 2.0; PetscErrorCode ierr; PetscFunctionBegin; ierr = MatSchurComplementGetSubMatrices(M, NULL, NULL, &B, &C, &D);CHKERRQ(ierr); ierr = MatSchurComplementGetKSP(M, &ksp);CHKERRQ(ierr); ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject) pc, PCLU, &isLU);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject) pc, PCILU, &isILU);CHKERRQ(ierr); if (isLU || isILU) { Mat fact, Bd, AinvB, AinvBd; PetscReal eps = 1.0e-10; /* This can be sped up for banded LU */ ierr = KSPSetUp(ksp);CHKERRQ(ierr); ierr = PCFactorGetMatrix(pc, &fact);CHKERRQ(ierr); ierr = MatConvert(B, MATDENSE, MAT_INITIAL_MATRIX, &Bd);CHKERRQ(ierr); ierr = MatDuplicate(Bd, MAT_DO_NOT_COPY_VALUES, &AinvBd);CHKERRQ(ierr); ierr = MatMatSolve(fact, Bd, AinvBd);CHKERRQ(ierr); ierr = MatDestroy(&Bd);CHKERRQ(ierr); ierr = MatChop(AinvBd, eps);CHKERRQ(ierr); ierr = MatConvert(AinvBd, MATAIJ, MAT_INITIAL_MATRIX, &AinvB);CHKERRQ(ierr); ierr = MatDestroy(&AinvBd);CHKERRQ(ierr); ierr = MatMatMult(C, AinvB, MAT_INITIAL_MATRIX, fill, S);CHKERRQ(ierr); ierr = MatDestroy(&AinvB);CHKERRQ(ierr); } else { Mat Ainvd, Ainv; ierr = PCComputeExplicitOperator(pc, &Ainvd);CHKERRQ(ierr); ierr = MatConvert(Ainvd, MATAIJ, MAT_INITIAL_MATRIX, &Ainv);CHKERRQ(ierr); ierr = MatDestroy(&Ainvd);CHKERRQ(ierr); #if 0 /* Symmetric version */ ierr = MatPtAP(Ainv, B, MAT_INITIAL_MATRIX, fill, S);CHKERRQ(ierr); #else /* Nonsymmetric version */ ierr = MatMatMatMult(C, Ainv, B, MAT_INITIAL_MATRIX, fill, S);CHKERRQ(ierr); #endif ierr = MatDestroy(&Ainv);CHKERRQ(ierr); } if (D) { ierr = MatAXPY(*S, -1.0, D, DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); } ierr = MatScale(*S,-1.0);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode PCSetUp_MG(PC pc) { PC_MG *mg = (PC_MG*)pc->data; PC_MG_Levels **mglevels = mg->levels; PetscErrorCode ierr; PetscInt i,n = mglevels[0]->levels; PC cpc; PetscBool dump = PETSC_FALSE,opsset,use_amat,missinginterpolate = PETSC_FALSE; Mat dA,dB; Vec tvec; DM *dms; PetscViewer viewer = 0; PetscFunctionBegin; /* FIX: Move this to PCSetFromOptions_MG? */ if (mg->usedmfornumberoflevels) { PetscInt levels; ierr = DMGetRefineLevel(pc->dm,&levels);CHKERRQ(ierr); levels++; if (levels > n) { /* the problem is now being solved on a finer grid */ ierr = PCMGSetLevels(pc,levels,NULL);CHKERRQ(ierr); n = levels; ierr = PCSetFromOptions(pc);CHKERRQ(ierr); /* it is bad to call this here, but otherwise will never be called for the new hierarchy */ mglevels = mg->levels; } } ierr = KSPGetPC(mglevels[0]->smoothd,&cpc);CHKERRQ(ierr); /* If user did not provide fine grid operators OR operator was not updated since last global KSPSetOperators() */ /* so use those from global PC */ /* Is this what we always want? What if user wants to keep old one? */ ierr = KSPGetOperatorsSet(mglevels[n-1]->smoothd,NULL,&opsset);CHKERRQ(ierr); if (opsset) { Mat mmat; ierr = KSPGetOperators(mglevels[n-1]->smoothd,NULL,&mmat);CHKERRQ(ierr); if (mmat == pc->pmat) opsset = PETSC_FALSE; } if (!opsset) { ierr = PCGetUseAmat(pc,&use_amat);CHKERRQ(ierr); if(use_amat){ ierr = PetscInfo(pc,"Using outer operators to define finest grid operator \n because PCMGGetSmoother(pc,nlevels-1,&ksp);KSPSetOperators(ksp,...); was not called.\n");CHKERRQ(ierr); ierr = KSPSetOperators(mglevels[n-1]->smoothd,pc->mat,pc->pmat);CHKERRQ(ierr); } else { ierr = PetscInfo(pc,"Using matrix (pmat) operators to define finest grid operator \n because PCMGGetSmoother(pc,nlevels-1,&ksp);KSPSetOperators(ksp,...); was not called.\n");CHKERRQ(ierr); ierr = KSPSetOperators(mglevels[n-1]->smoothd,pc->pmat,pc->pmat);CHKERRQ(ierr); } } for (i=n-1; i>0; i--) { if (!(mglevels[i]->interpolate || mglevels[i]->restrct)) { missinginterpolate = PETSC_TRUE; continue; } } /* Skipping if user has provided all interpolation/restriction needed (since DM might not be able to produce them (when coming from SNES/TS) Skipping for galerkin==2 (externally managed hierarchy such as ML and GAMG). Cleaner logic here would be great. Wrap ML/GAMG as DMs? */ if (missinginterpolate && pc->dm && mg->galerkin != 2 && !pc->setupcalled) { /* construct the interpolation from the DMs */ Mat p; Vec rscale; ierr = PetscMalloc1(n,&dms);CHKERRQ(ierr); dms[n-1] = pc->dm; /* Separately create them so we do not get DMKSP interference between levels */ for (i=n-2; i>-1; i--) {ierr = DMCoarsen(dms[i+1],MPI_COMM_NULL,&dms[i]);CHKERRQ(ierr);} for (i=n-2; i>-1; i--) { DMKSP kdm; PetscBool dmhasrestrict; ierr = KSPSetDM(mglevels[i]->smoothd,dms[i]);CHKERRQ(ierr); if (mg->galerkin) {ierr = KSPSetDMActive(mglevels[i]->smoothd,PETSC_FALSE);CHKERRQ(ierr);} ierr = DMGetDMKSPWrite(dms[i],&kdm);CHKERRQ(ierr); /* Ugly hack so that the next KSPSetUp() will use the RHS that we set. A better fix is to change dmActive to take * a bitwise OR of computing the matrix, RHS, and initial iterate. */ kdm->ops->computerhs = NULL; kdm->rhsctx = NULL; if (!mglevels[i+1]->interpolate) { ierr = DMCreateInterpolation(dms[i],dms[i+1],&p,&rscale);CHKERRQ(ierr); ierr = PCMGSetInterpolation(pc,i+1,p);CHKERRQ(ierr); if (rscale) {ierr = PCMGSetRScale(pc,i+1,rscale);CHKERRQ(ierr);} ierr = VecDestroy(&rscale);CHKERRQ(ierr); ierr = MatDestroy(&p);CHKERRQ(ierr); } ierr = DMHasCreateRestriction(dms[i],&dmhasrestrict);CHKERRQ(ierr); if (dmhasrestrict && !mglevels[i+1]->restrct){ ierr = DMCreateRestriction(dms[i],dms[i+1],&p);CHKERRQ(ierr); ierr = PCMGSetRestriction(pc,i+1,p);CHKERRQ(ierr); ierr = MatDestroy(&p);CHKERRQ(ierr); } } for (i=n-2; i>-1; i--) {ierr = DMDestroy(&dms[i]);CHKERRQ(ierr);} ierr = PetscFree(dms);CHKERRQ(ierr); } if (pc->dm && !pc->setupcalled) { /* finest smoother also gets DM but it is not active, independent of whether galerkin==2 */ ierr = KSPSetDM(mglevels[n-1]->smoothd,pc->dm);CHKERRQ(ierr); ierr = KSPSetDMActive(mglevels[n-1]->smoothd,PETSC_FALSE);CHKERRQ(ierr); } if (mg->galerkin == 1) { Mat B; /* currently only handle case where mat and pmat are the same on coarser levels */ ierr = KSPGetOperators(mglevels[n-1]->smoothd,&dA,&dB);CHKERRQ(ierr); if (!pc->setupcalled) { for (i=n-2; i>-1; i--) { if (!mglevels[i+1]->restrct && !mglevels[i+1]->interpolate) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"Must provide interpolation or restriction for each MG level except level 0"); if (!mglevels[i+1]->interpolate) { ierr = PCMGSetInterpolation(pc,i+1,mglevels[i+1]->restrct);CHKERRQ(ierr); } if (!mglevels[i+1]->restrct) { ierr = PCMGSetRestriction(pc,i+1,mglevels[i+1]->interpolate);CHKERRQ(ierr); } if (mglevels[i+1]->interpolate == mglevels[i+1]->restrct) { ierr = MatPtAP(dB,mglevels[i+1]->interpolate,MAT_INITIAL_MATRIX,1.0,&B);CHKERRQ(ierr); } else { ierr = MatMatMatMult(mglevels[i+1]->restrct,dB,mglevels[i+1]->interpolate,MAT_INITIAL_MATRIX,1.0,&B);CHKERRQ(ierr); } ierr = KSPSetOperators(mglevels[i]->smoothd,B,B);CHKERRQ(ierr); if (i != n-2) {ierr = PetscObjectDereference((PetscObject)dB);CHKERRQ(ierr);} dB = B; } if (n > 1) {ierr = PetscObjectDereference((PetscObject)dB);CHKERRQ(ierr);} } else { for (i=n-2; i>-1; i--) { if (!mglevels[i+1]->restrct && !mglevels[i+1]->interpolate) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"Must provide interpolation or restriction for each MG level except level 0"); if (!mglevels[i+1]->interpolate) { ierr = PCMGSetInterpolation(pc,i+1,mglevels[i+1]->restrct);CHKERRQ(ierr); } if (!mglevels[i+1]->restrct) { ierr = PCMGSetRestriction(pc,i+1,mglevels[i+1]->interpolate);CHKERRQ(ierr); } ierr = KSPGetOperators(mglevels[i]->smoothd,NULL,&B);CHKERRQ(ierr); if (mglevels[i+1]->interpolate == mglevels[i+1]->restrct) { ierr = MatPtAP(dB,mglevels[i+1]->interpolate,MAT_REUSE_MATRIX,1.0,&B);CHKERRQ(ierr); } else { ierr = MatMatMatMult(mglevels[i+1]->restrct,dB,mglevels[i+1]->interpolate,MAT_REUSE_MATRIX,1.0,&B);CHKERRQ(ierr); } ierr = KSPSetOperators(mglevels[i]->smoothd,B,B);CHKERRQ(ierr); dB = B; } } } else if (!mg->galerkin && pc->dm && pc->dm->x) { /* need to restrict Jacobian location to coarser meshes for evaluation */ for (i=n-2; i>-1; i--) { Mat R; Vec rscale; if (!mglevels[i]->smoothd->dm->x) { Vec *vecs; ierr = KSPCreateVecs(mglevels[i]->smoothd,1,&vecs,0,NULL);CHKERRQ(ierr); mglevels[i]->smoothd->dm->x = vecs[0]; ierr = PetscFree(vecs);CHKERRQ(ierr); } ierr = PCMGGetRestriction(pc,i+1,&R);CHKERRQ(ierr); ierr = PCMGGetRScale(pc,i+1,&rscale);CHKERRQ(ierr); ierr = MatRestrict(R,mglevels[i+1]->smoothd->dm->x,mglevels[i]->smoothd->dm->x);CHKERRQ(ierr); ierr = VecPointwiseMult(mglevels[i]->smoothd->dm->x,mglevels[i]->smoothd->dm->x,rscale);CHKERRQ(ierr); } } if (!mg->galerkin && pc->dm) { for (i=n-2; i>=0; i--) { DM dmfine,dmcoarse; Mat Restrict,Inject; Vec rscale; ierr = KSPGetDM(mglevels[i+1]->smoothd,&dmfine);CHKERRQ(ierr); ierr = KSPGetDM(mglevels[i]->smoothd,&dmcoarse);CHKERRQ(ierr); ierr = PCMGGetRestriction(pc,i+1,&Restrict);CHKERRQ(ierr); ierr = PCMGGetRScale(pc,i+1,&rscale);CHKERRQ(ierr); Inject = NULL; /* Callback should create it if it needs Injection */ ierr = DMRestrict(dmfine,Restrict,rscale,Inject,dmcoarse);CHKERRQ(ierr); } } if (!pc->setupcalled) { for (i=0; i<n; i++) { ierr = KSPSetFromOptions(mglevels[i]->smoothd);CHKERRQ(ierr); } for (i=1; i<n; i++) { if (mglevels[i]->smoothu && (mglevels[i]->smoothu != mglevels[i]->smoothd)) { ierr = KSPSetFromOptions(mglevels[i]->smoothu);CHKERRQ(ierr); } } /* insure that if either interpolation or restriction is set the other other one is set */ for (i=1; i<n; i++) { ierr = PCMGGetInterpolation(pc,i,NULL);CHKERRQ(ierr); ierr = PCMGGetRestriction(pc,i,NULL);CHKERRQ(ierr); } for (i=0; i<n-1; i++) { if (!mglevels[i]->b) { Vec *vec; ierr = KSPCreateVecs(mglevels[i]->smoothd,1,&vec,0,NULL);CHKERRQ(ierr); ierr = PCMGSetRhs(pc,i,*vec);CHKERRQ(ierr); ierr = VecDestroy(vec);CHKERRQ(ierr); ierr = PetscFree(vec);CHKERRQ(ierr); } if (!mglevels[i]->r && i) { ierr = VecDuplicate(mglevels[i]->b,&tvec);CHKERRQ(ierr); ierr = PCMGSetR(pc,i,tvec);CHKERRQ(ierr); ierr = VecDestroy(&tvec);CHKERRQ(ierr); } if (!mglevels[i]->x) { ierr = VecDuplicate(mglevels[i]->b,&tvec);CHKERRQ(ierr); ierr = PCMGSetX(pc,i,tvec);CHKERRQ(ierr); ierr = VecDestroy(&tvec);CHKERRQ(ierr); } } if (n != 1 && !mglevels[n-1]->r) { /* PCMGSetR() on the finest level if user did not supply it */ Vec *vec; ierr = KSPCreateVecs(mglevels[n-1]->smoothd,1,&vec,0,NULL);CHKERRQ(ierr); ierr = PCMGSetR(pc,n-1,*vec);CHKERRQ(ierr); ierr = VecDestroy(vec);CHKERRQ(ierr); ierr = PetscFree(vec);CHKERRQ(ierr); } } if (pc->dm) { /* need to tell all the coarser levels to rebuild the matrix using the DM for that level */ for (i=0; i<n-1; i++) { if (mglevels[i]->smoothd->setupstage != KSP_SETUP_NEW) mglevels[i]->smoothd->setupstage = KSP_SETUP_NEWMATRIX; } } for (i=1; i<n; i++) { if (mglevels[i]->smoothu == mglevels[i]->smoothd || mg->am == PC_MG_FULL || mg->am == PC_MG_KASKADE || mg->cyclesperpcapply > 1){ /* if doing only down then initial guess is zero */ ierr = KSPSetInitialGuessNonzero(mglevels[i]->smoothd,PETSC_TRUE);CHKERRQ(ierr); } if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventBegin(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);} ierr = KSPSetUp(mglevels[i]->smoothd);CHKERRQ(ierr); if (mglevels[i]->smoothd->reason == KSP_DIVERGED_PCSETUP_FAILED) { pc->failedreason = PC_SUBPC_ERROR; } if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventEnd(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);} if (!mglevels[i]->residual) { Mat mat; ierr = KSPGetOperators(mglevels[i]->smoothd,NULL,&mat);CHKERRQ(ierr); ierr = PCMGSetResidual(pc,i,PCMGResidualDefault,mat);CHKERRQ(ierr); } } for (i=1; i<n; i++) { if (mglevels[i]->smoothu && mglevels[i]->smoothu != mglevels[i]->smoothd) { Mat downmat,downpmat; /* check if operators have been set for up, if not use down operators to set them */ ierr = KSPGetOperatorsSet(mglevels[i]->smoothu,&opsset,NULL);CHKERRQ(ierr); if (!opsset) { ierr = KSPGetOperators(mglevels[i]->smoothd,&downmat,&downpmat);CHKERRQ(ierr); ierr = KSPSetOperators(mglevels[i]->smoothu,downmat,downpmat);CHKERRQ(ierr); } ierr = KSPSetInitialGuessNonzero(mglevels[i]->smoothu,PETSC_TRUE);CHKERRQ(ierr); if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventBegin(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);} ierr = KSPSetUp(mglevels[i]->smoothu);CHKERRQ(ierr); if (mglevels[i]->smoothu->reason == KSP_DIVERGED_PCSETUP_FAILED) { pc->failedreason = PC_SUBPC_ERROR; } if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventEnd(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);} } } if (mglevels[0]->eventsmoothsetup) {ierr = PetscLogEventBegin(mglevels[0]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);} ierr = KSPSetUp(mglevels[0]->smoothd);CHKERRQ(ierr); if (mglevels[0]->smoothd->reason == KSP_DIVERGED_PCSETUP_FAILED) { pc->failedreason = PC_SUBPC_ERROR; } if (mglevels[0]->eventsmoothsetup) {ierr = PetscLogEventEnd(mglevels[0]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);} /* Dump the interpolation/restriction matrices plus the Jacobian/stiffness on each level. This allows MATLAB users to easily check if the Galerkin condition A_c = R A_f R^T is satisfied. Only support one or the other at the same time. */ #if defined(PETSC_USE_SOCKET_VIEWER) ierr = PetscOptionsGetBool(((PetscObject)pc)->options,((PetscObject)pc)->prefix,"-pc_mg_dump_matlab",&dump,NULL);CHKERRQ(ierr); if (dump) viewer = PETSC_VIEWER_SOCKET_(PetscObjectComm((PetscObject)pc)); dump = PETSC_FALSE; #endif ierr = PetscOptionsGetBool(((PetscObject)pc)->options,((PetscObject)pc)->prefix,"-pc_mg_dump_binary",&dump,NULL);CHKERRQ(ierr); if (dump) viewer = PETSC_VIEWER_BINARY_(PetscObjectComm((PetscObject)pc)); if (viewer) { for (i=1; i<n; i++) { ierr = MatView(mglevels[i]->restrct,viewer);CHKERRQ(ierr); } for (i=0; i<n; i++) { ierr = KSPGetPC(mglevels[i]->smoothd,&pc);CHKERRQ(ierr); ierr = MatView(pc->mat,viewer);CHKERRQ(ierr); } } PetscFunctionReturn(0); }
-fA <input_file> -fB <input_file> -fC <input_file> \n\n"; #include <petscmat.h> #undef __FUNCT__ #define __FUNCT__ "main" int main(int argc,char **args) { Mat A,B,C,D,BC,ABC; PetscViewer fd; char file[3][PETSC_MAX_PATH_LEN]; PetscBool flg; PetscErrorCode ierr; PetscInitialize(&argc,&args,(char*)0,help); /* read matrices A, B and C */ ierr = PetscOptionsGetString(NULL,NULL,"-fA",file[0],PETSC_MAX_PATH_LEN,&flg);CHKERRQ(ierr); if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Must indicate binary file with the -fA options"); ierr = PetscOptionsGetString(NULL,NULL,"-fB",file[1],PETSC_MAX_PATH_LEN,&flg);CHKERRQ(ierr); if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Must indicate binary file with the -fB options"); ierr = PetscOptionsGetString(NULL,NULL,"-fC",file[2],PETSC_MAX_PATH_LEN,&flg);CHKERRQ(ierr); if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Must indicate binary file with the -fC options"); /* Load matrices */ ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[0],FILE_MODE_READ,&fd);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatLoad(A,fd);CHKERRQ(ierr); ierr = PetscViewerDestroy(&fd);CHKERRQ(ierr); ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[1],FILE_MODE_READ,&fd);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&B);CHKERRQ(ierr); ierr = MatLoad(B,fd);CHKERRQ(ierr); ierr = PetscViewerDestroy(&fd);CHKERRQ(ierr); ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[2],FILE_MODE_READ,&fd);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr); ierr = MatLoad(C,fd);CHKERRQ(ierr); ierr = PetscViewerDestroy(&fd);CHKERRQ(ierr); /* Test MatMatMult() */ ierr = MatMatMult(B,C,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&BC);CHKERRQ(ierr); ierr = MatMatMult(A,BC,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&ABC);CHKERRQ(ierr); ierr = MatMatMatMult(A,B,C,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&D);CHKERRQ(ierr); ierr = MatMatMatMult(A,B,C,MAT_REUSE_MATRIX,PETSC_DEFAULT,&D);CHKERRQ(ierr); /* ierr = MatView(D,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); */ ierr = MatEqual(ABC,D,&flg);CHKERRQ(ierr); if (!flg) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_INCOMP,"ABC != D"); ierr = MatDestroy(&ABC);CHKERRQ(ierr); ierr = MatDestroy(&BC);CHKERRQ(ierr); ierr = MatDestroy(&D);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = MatDestroy(&B);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); PetscFinalize(); return 0; }
/* Mm_ratio - ration of grid lines between fine and coarse grids. */ int main(int argc,char **argv) { PetscErrorCode ierr; AppCtx user; PetscMPIInt size,rank; PetscInt m,n,M,N,i,nrows; PetscScalar one = 1.0; PetscReal fill=2.0; Mat A,P,R,C,PtAP; PetscScalar *array; PetscRandom rdm; PetscBool Test_3D=PETSC_FALSE,flg; const PetscInt *ia,*ja; ierr = PetscInitialize(&argc,&argv,NULL,help);if (ierr) return ierr; ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); /* Get size of fine grids and coarse grids */ user.ratio = 2; user.coarse.mx = 4; user.coarse.my = 4; user.coarse.mz = 4; ierr = PetscOptionsGetInt(NULL,NULL,"-Mx",&user.coarse.mx,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-My",&user.coarse.my,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-Mz",&user.coarse.mz,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-ratio",&user.ratio,NULL);CHKERRQ(ierr); if (user.coarse.mz) Test_3D = PETSC_TRUE; user.fine.mx = user.ratio*(user.coarse.mx-1)+1; user.fine.my = user.ratio*(user.coarse.my-1)+1; user.fine.mz = user.ratio*(user.coarse.mz-1)+1; if (!rank) { if (!Test_3D) { ierr = PetscPrintf(PETSC_COMM_SELF,"coarse grids: %D %D; fine grids: %D %D\n",user.coarse.mx,user.coarse.my,user.fine.mx,user.fine.my);CHKERRQ(ierr); } else { ierr = PetscPrintf(PETSC_COMM_SELF,"coarse grids: %D %D %D; fine grids: %D %D %D\n",user.coarse.mx,user.coarse.my,user.coarse.mz,user.fine.mx,user.fine.my,user.fine.mz);CHKERRQ(ierr); } } /* Set up distributed array for fine grid */ if (!Test_3D) { ierr = DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,user.fine.mx,user.fine.my,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,&user.fine.da);CHKERRQ(ierr); } else { ierr = DMDACreate3d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,user.fine.mx,user.fine.my,user.fine.mz,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE, 1,1,NULL,NULL,NULL,&user.fine.da);CHKERRQ(ierr); } ierr = DMSetFromOptions(user.fine.da);CHKERRQ(ierr); ierr = DMSetUp(user.fine.da);CHKERRQ(ierr); /* Create and set A at fine grids */ ierr = DMSetMatType(user.fine.da,MATAIJ);CHKERRQ(ierr); ierr = DMCreateMatrix(user.fine.da,&A);CHKERRQ(ierr); ierr = MatGetLocalSize(A,&m,&n);CHKERRQ(ierr); ierr = MatGetSize(A,&M,&N);CHKERRQ(ierr); /* set val=one to A (replace with random values!) */ ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rdm);CHKERRQ(ierr); ierr = PetscRandomSetFromOptions(rdm);CHKERRQ(ierr); if (size == 1) { ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr); if (flg) { ierr = MatSeqAIJGetArray(A,&array);CHKERRQ(ierr); for (i=0; i<ia[nrows]; i++) array[i] = one; ierr = MatSeqAIJRestoreArray(A,&array);CHKERRQ(ierr); } ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr); } else { Mat AA,AB; ierr = MatMPIAIJGetSeqAIJ(A,&AA,&AB,NULL);CHKERRQ(ierr); ierr = MatGetRowIJ(AA,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr); if (flg) { ierr = MatSeqAIJGetArray(AA,&array);CHKERRQ(ierr); for (i=0; i<ia[nrows]; i++) array[i] = one; ierr = MatSeqAIJRestoreArray(AA,&array);CHKERRQ(ierr); } ierr = MatRestoreRowIJ(AA,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr); ierr = MatGetRowIJ(AB,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr); if (flg) { ierr = MatSeqAIJGetArray(AB,&array);CHKERRQ(ierr); for (i=0; i<ia[nrows]; i++) array[i] = one; ierr = MatSeqAIJRestoreArray(AB,&array);CHKERRQ(ierr); } ierr = MatRestoreRowIJ(AB,0,PETSC_FALSE,PETSC_FALSE,&nrows,&ia,&ja,&flg);CHKERRQ(ierr); } /* Set up distributed array for coarse grid */ if (!Test_3D) { ierr = DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,user.coarse.mx,user.coarse.my,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,&user.coarse.da);CHKERRQ(ierr); } else { ierr = DMDACreate3d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,user.coarse.mx,user.coarse.my,user.coarse.mz,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,NULL,&user.coarse.da);CHKERRQ(ierr); } ierr = DMSetFromOptions(user.coarse.da);CHKERRQ(ierr); ierr = DMSetUp(user.coarse.da);CHKERRQ(ierr); /* Create interpolation between the fine and coarse grids */ ierr = DMCreateInterpolation(user.coarse.da,user.fine.da,&P,NULL);CHKERRQ(ierr); /* Get R = P^T */ ierr = MatTranspose(P,MAT_INITIAL_MATRIX,&R);CHKERRQ(ierr); /* C = R*A*P */ ierr = MatMatMatMult(R,A,P,MAT_INITIAL_MATRIX,fill,&C);CHKERRQ(ierr); ierr = MatMatMatMult(R,A,P,MAT_REUSE_MATRIX,fill,&C);CHKERRQ(ierr); /* Test C == PtAP */ ierr = MatPtAP(A,P,MAT_INITIAL_MATRIX,fill,&PtAP);CHKERRQ(ierr); ierr = MatPtAP(A,P,MAT_REUSE_MATRIX,fill,&PtAP);CHKERRQ(ierr); ierr = MatEqual(C,PtAP,&flg);CHKERRQ(ierr); if (!flg) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_PLIB,"Matrices are not equal"); ierr = MatDestroy(&PtAP);CHKERRQ(ierr); /* Clean up */ ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = PetscRandomDestroy(&rdm);CHKERRQ(ierr); ierr = DMDestroy(&user.fine.da);CHKERRQ(ierr); ierr = DMDestroy(&user.coarse.da);CHKERRQ(ierr); ierr = MatDestroy(&P);CHKERRQ(ierr); ierr = MatDestroy(&R);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }