/*@ SVDSolve - Solves the singular value problem. Collective on SVD Input Parameter: . svd - singular value solver context obtained from SVDCreate() Options Database Keys: + -svd_view - print information about the solver used - -svd_view_mat binary - save the matrix to the default binary viewer Level: beginner .seealso: SVDCreate(), SVDSetUp(), SVDDestroy() @*/ PetscErrorCode SVDSolve(SVD svd) { PetscErrorCode ierr; PetscBool flg; PetscInt i,*workperm; PetscViewer viewer; PetscViewerFormat format; PetscFunctionBegin; PetscValidHeaderSpecific(svd,SVD_CLASSID,1); ierr = PetscLogEventBegin(SVD_Solve,svd,0,0,0);CHKERRQ(ierr); /* call setup */ ierr = SVDSetUp(svd);CHKERRQ(ierr); svd->its = 0; svd->nconv = 0; for (i=0;i<svd->ncv;i++) { svd->sigma[i] = 0.0; svd->errest[i] = 0.0; } ierr = SVDMonitor(svd,svd->its,svd->nconv,svd->sigma,svd->errest,svd->ncv);CHKERRQ(ierr); ierr = (*svd->ops->solve)(svd);CHKERRQ(ierr); /* sort singular triplets */ if (svd->which == SVD_SMALLEST) { for (i=0;i<svd->nconv;i++) svd->perm[i] = i; ierr = PetscSortRealWithPermutation(svd->nconv,svd->sigma,svd->perm);CHKERRQ(ierr); } else { ierr = PetscMalloc(sizeof(PetscInt)*svd->nconv,&workperm);CHKERRQ(ierr); for (i=0;i<svd->nconv;i++) workperm[i] = i; ierr = PetscSortRealWithPermutation(svd->nconv,svd->sigma,workperm);CHKERRQ(ierr); for (i=0;i<svd->nconv;i++) svd->perm[i] = workperm[svd->nconv-i-1]; ierr = PetscFree(workperm);CHKERRQ(ierr); } svd->lvecsavail = (svd->leftbasis)? PETSC_TRUE: PETSC_FALSE; ierr = PetscLogEventEnd(SVD_Solve,svd,0,0,0);CHKERRQ(ierr); /* various viewers */ ierr = MatViewFromOptions(svd->OP,((PetscObject)svd)->prefix,"-svd_view_mat");CHKERRQ(ierr); ierr = PetscOptionsGetViewer(PetscObjectComm((PetscObject)svd),((PetscObject)svd)->prefix,"-svd_view",&viewer,&format,&flg);CHKERRQ(ierr); if (flg && !PetscPreLoadingOn) { ierr = PetscViewerPushFormat(viewer,format);CHKERRQ(ierr); ierr = SVDView(svd,viewer);CHKERRQ(ierr); ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); } /* Remove the initial subspaces */ svd->nini = 0; svd->ninil = 0; PetscFunctionReturn(0); }
int main(int argc,char **argv) { PetscInt M = 5,N = 4,P = 3, m = PETSC_DECIDE,n = PETSC_DECIDE,p = PETSC_DECIDE,dim = 1; PetscErrorCode ierr; DM dac,daf; DMDABoundaryType bx=DMDA_BOUNDARY_NONE,by=DMDA_BOUNDARY_NONE,bz=DMDA_BOUNDARY_NONE; DMDAStencilType stype = DMDA_STENCIL_BOX; Mat A; ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr); /* Read options */ ierr = PetscOptionsGetInt(PETSC_NULL,"-M",&M,PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(PETSC_NULL,"-N",&N,PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(PETSC_NULL,"-P",&P,PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(PETSC_NULL,"-p",&p,PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(PETSC_NULL,"-dim",&dim,PETSC_NULL);CHKERRQ(ierr); /* Create distributed array and get vectors */ if (dim == 1) { ierr = DMDACreate1d(PETSC_COMM_WORLD,bx,M,1,1,PETSC_NULL,&dac);CHKERRQ(ierr); } else if (dim == 2) { ierr = DMDACreate2d(PETSC_COMM_WORLD,bx,by,stype,M,N,PETSC_DECIDE,PETSC_DECIDE,1,1,PETSC_NULL,PETSC_NULL,&dac);CHKERRQ(ierr); } else if (dim == 3) { ierr = DMDACreate3d(PETSC_COMM_WORLD,bx,by,bz,stype,M,N,P,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,1,1,PETSC_NULL,PETSC_NULL,PETSC_NULL,&dac);CHKERRQ(ierr); } ierr = DMRefine(dac,PETSC_COMM_WORLD,&daf);CHKERRQ(ierr); ierr = DMDASetUniformCoordinates(dac,0.0,1.0,0.0,1.0,0.0,1.0);CHKERRQ(ierr); if (dim == 1) { ierr = SetCoordinates1d(daf);CHKERRQ(ierr); } else if (dim == 2) { ierr = SetCoordinates2d(daf);CHKERRQ(ierr); } else if (dim == 3) { ierr = SetCoordinates3d(daf);CHKERRQ(ierr); } ierr = DMCreateInterpolation(dac,daf,&A,0);CHKERRQ(ierr); ierr = MatViewFromOptions(A,"-mat_view");CHKERRQ(ierr); /* Free memory */ ierr = DMDestroy(&dac);CHKERRQ(ierr); ierr = DMDestroy(&daf);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }
/*@ MFNSolve - Solves the matrix function problem. Given a vector b, the vector x = f(alpha*A)*b is returned. Collective on MFN Input Parameters: + mfn - matrix function context obtained from MFNCreate() - b - the right hand side vector Output Parameter: . x - the solution (this may be the same vector as b, then b will be overwritten with the answer) Options Database Keys: + -mfn_view - print information about the solver used . -mfn_view_mat binary - save the matrix to the default binary viewer . -mfn_view_rhs binary - save right hand side vector to the default binary viewer - -mfn_view_solution binary - save computed solution vector to the default binary viewer Notes: The matrix A is specified with MFNSetOperator(). The function f is specified with MFNSetFunction(). The scalar alpha is specified with MFNSetScaleFactor(). Level: beginner .seealso: MFNCreate(), MFNSetUp(), MFNDestroy(), MFNSetTolerances(), MFNSetOperator(), MFNSetFunction(), MFNSetScaleFactor() @*/ PetscErrorCode MFNSolve(MFN mfn,Vec b,Vec x) { PetscErrorCode ierr; PetscBool flg; PetscViewer viewer; PetscViewerFormat format; PetscFunctionBegin; PetscValidHeaderSpecific(mfn,MFN_CLASSID,1); PetscValidHeaderSpecific(b,VEC_CLASSID,2); PetscCheckSameComm(mfn,1,b,2); if (b!=x) PetscValidHeaderSpecific(x,VEC_CLASSID,3); if (b!=x) PetscCheckSameComm(mfn,1,x,3); /* call setup */ ierr = MFNSetUp(mfn);CHKERRQ(ierr); mfn->its = 0; ierr = MFNMonitor(mfn,mfn->its,0);CHKERRQ(ierr); /* call solver */ ierr = PetscLogEventBegin(MFN_Solve,mfn,b,x,0);CHKERRQ(ierr); ierr = (*mfn->ops->solve)(mfn,b,x);CHKERRQ(ierr); ierr = PetscLogEventEnd(MFN_Solve,mfn,b,x,0);CHKERRQ(ierr); if (!mfn->reason) SETERRQ(PetscObjectComm((PetscObject)mfn),PETSC_ERR_PLIB,"Internal error, solver returned without setting converged reason"); if (mfn->errorifnotconverged && mfn->reason < 0) SETERRQ(PetscObjectComm((PetscObject)mfn),PETSC_ERR_NOT_CONVERGED,"MFNSolve has not converged"); /* various viewers */ ierr = MatViewFromOptions(mfn->A,((PetscObject)mfn)->prefix,"-mfn_view_mat");CHKERRQ(ierr); ierr = VecViewFromOptions(b,((PetscObject)mfn)->prefix,"-mfn_view_rhs");CHKERRQ(ierr); ierr = VecViewFromOptions(x,((PetscObject)mfn)->prefix,"-mfn_view_solution");CHKERRQ(ierr); ierr = PetscOptionsGetViewer(PetscObjectComm((PetscObject)mfn),((PetscObject)mfn)->prefix,"-mfn_view",&viewer,&format,&flg);CHKERRQ(ierr); if (flg && !PetscPreLoadingOn) { ierr = PetscViewerPushFormat(viewer,format);CHKERRQ(ierr); ierr = MFNView(mfn,viewer);CHKERRQ(ierr); ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); } PetscFunctionReturn(0); }
int main(int argc, char** argv) { Mat Q; Vec v, a, se; KSP QRsolver; PC pc; PetscErrorCode ierr; ierr = PetscInitialize(&argc, &argv, NULL, NULL);if (ierr) return ierr; ierr = VecCreate(PETSC_COMM_WORLD, &v);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD, &Q);CHKERRQ(ierr); ierr = MatSetType(Q, MATDENSE);CHKERRQ(ierr); ierr = fill(Q, v);CHKERRQ(ierr); ierr = MatCreateVecs(Q, &a, NULL);CHKERRQ(ierr); ierr = KSPCreate(PETSC_COMM_WORLD, &QRsolver);CHKERRQ(ierr); ierr = KSPGetPC(QRsolver, &pc);CHKERRQ(ierr); ierr = PCSetType(pc, PCNONE);CHKERRQ(ierr); ierr = KSPSetType(QRsolver, KSPLSQR);CHKERRQ(ierr); ierr = KSPSetFromOptions(QRsolver);CHKERRQ(ierr); ierr = KSPSetOperators(QRsolver, Q, Q);CHKERRQ(ierr); ierr = MatViewFromOptions(Q, NULL, "-sys_view");CHKERRQ(ierr); ierr = VecViewFromOptions(a, NULL, "-rhs_view");CHKERRQ(ierr); ierr = KSPSolve(QRsolver, v, a);CHKERRQ(ierr); ierr = KSPLSQRGetStandardErrorVec(QRsolver, &se);CHKERRQ(ierr); if (se) { ierr = VecViewFromOptions(se, NULL, "-se_view");CHKERRQ(ierr); } ierr = KSPDestroy(&QRsolver);CHKERRQ(ierr); ierr = VecDestroy(&a);CHKERRQ(ierr); ierr = VecDestroy(&v);CHKERRQ(ierr); ierr = MatDestroy(&Q);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }
/*@C SNESUpdateCheckJacobian - Checks each Jacobian computed by the nonlinear solver comparing the users function with a finite difference computation. Options Database: + -snes_check_jacobian - use this every time SNESSolve() is called - -snes_check_jacobian_view - Display difference between approximate and hand-coded Jacobian Level: intermediate .seealso: SNESCreate(), SNES, SNESSetType(), SNESNEWTONLS, SNESNEWTONTR, SNESSolve() @*/ PetscErrorCode SNESUpdateCheckJacobian(SNES snes,PetscInt it) { Mat A = snes->jacobian,B; Vec x = snes->vec_sol,f = snes->vec_func,f1 = snes->vec_sol_update; PetscErrorCode ierr; PetscReal nrm,gnorm; PetscErrorCode (*objective)(SNES,Vec,PetscReal*,void*); void *ctx; PetscReal fnorm,f1norm,dnorm; PetscInt m,n,M,N; PetscBool complete_print = PETSC_FALSE; void *functx; PetscViewer viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)snes)); PetscFunctionBegin; ierr = PetscOptionsHasName(((PetscObject)snes)->prefix,"-snes_check_jacobian_view",&complete_print);CHKERRQ(ierr); if (A != snes->jacobian_pre) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Cannot check Jacobian with alternative preconditioner"); ierr = PetscViewerASCIIAddTab(viewer,((PetscObject)snes)->tablevel);CHKERRQ(ierr); ierr = PetscViewerASCIIPrintf(viewer," Testing hand-coded Jacobian, if the ratio is O(1.e-8), the hand-coded Jacobian is probably correct.\n");CHKERRQ(ierr); if (!complete_print) { ierr = PetscViewerASCIIPrintf(viewer," Run with -snes_check_jacobian_view [viewer][:filename][:format] to show difference of hand-coded and finite difference Jacobian.\n");CHKERRQ(ierr); } /* compute both versions of Jacobian */ ierr = SNESComputeJacobian(snes,x,A,A);CHKERRQ(ierr); ierr = MatCreate(PetscObjectComm((PetscObject)A),&B);CHKERRQ(ierr); ierr = MatGetSize(A,&M,&N);CHKERRQ(ierr); ierr = MatGetLocalSize(A,&m,&n);CHKERRQ(ierr); ierr = MatSetSizes(B,m,n,M,N);CHKERRQ(ierr); ierr = MatSetType(B,((PetscObject)A)->type_name);CHKERRQ(ierr); ierr = MatSetUp(B);CHKERRQ(ierr); ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); ierr = SNESGetFunction(snes,NULL,NULL,&functx);CHKERRQ(ierr); ierr = SNESComputeJacobianDefault(snes,x,B,B,functx);CHKERRQ(ierr); if (complete_print) { ierr = PetscViewerASCIIPrintf(viewer," Finite difference Jacobian\n");CHKERRQ(ierr); ierr = MatViewFromOptions(B,((PetscObject)snes)->prefix,"-snes_check_jacobian_view");CHKERRQ(ierr); } /* compare */ ierr = MatAYPX(B,-1.0,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = MatNorm(B,NORM_FROBENIUS,&nrm);CHKERRQ(ierr); ierr = MatNorm(A,NORM_FROBENIUS,&gnorm);CHKERRQ(ierr); if (complete_print) { ierr = PetscViewerASCIIPrintf(viewer," Hand-coded Jacobian\n");CHKERRQ(ierr); ierr = MatViewFromOptions(A,((PetscObject)snes)->prefix,"-snes_check_jacobian_view");CHKERRQ(ierr); ierr = PetscViewerASCIIPrintf(viewer," Hand-coded minus finite difference Jacobian\n");CHKERRQ(ierr); ierr = MatViewFromOptions(B,((PetscObject)snes)->prefix,"-snes_check_jacobian_view");CHKERRQ(ierr); } if (!gnorm) gnorm = 1; /* just in case */ ierr = PetscViewerASCIIPrintf(viewer," %g = ||J - Jfd||//J|| %g = ||J - Jfd||\n",(double)(nrm/gnorm),(double)nrm);CHKERRQ(ierr); ierr = SNESGetObjective(snes,&objective,&ctx);CHKERRQ(ierr); if (objective) { ierr = SNESComputeFunction(snes,x,f);CHKERRQ(ierr); ierr = VecNorm(f,NORM_2,&fnorm);CHKERRQ(ierr); if (complete_print) { ierr = PetscViewerASCIIPrintf(viewer," Hand-coded Objective Function \n");CHKERRQ(ierr); ierr = VecView(f,viewer);CHKERRQ(ierr); } ierr = SNESObjectiveComputeFunctionDefaultFD(snes,x,f1,NULL);CHKERRQ(ierr); ierr = VecNorm(f1,NORM_2,&f1norm);CHKERRQ(ierr); if (complete_print) { ierr = PetscViewerASCIIPrintf(viewer," Finite-Difference Objective Function\n");CHKERRQ(ierr); ierr = VecView(f1,viewer);CHKERRQ(ierr); } /* compare the two */ ierr = VecAXPY(f,-1.0,f1);CHKERRQ(ierr); ierr = VecNorm(f,NORM_2,&dnorm);CHKERRQ(ierr); if (!fnorm) fnorm = 1.; ierr = PetscViewerASCIIPrintf(viewer," %g = Norm of objective function ratio %g = difference\n",dnorm/fnorm,dnorm);CHKERRQ(ierr); if (complete_print) { ierr = PetscViewerASCIIPrintf(viewer," Difference\n");CHKERRQ(ierr); ierr = VecView(f,viewer);CHKERRQ(ierr); } } ierr = PetscViewerASCIISubtractTab(viewer,((PetscObject)snes)->tablevel);CHKERRQ(ierr); ierr = MatDestroy(&B);CHKERRQ(ierr); PetscFunctionReturn(0); }
/*@ EPSSolve - Solves the eigensystem. Collective on EPS Input Parameter: . eps - eigensolver context obtained from EPSCreate() Options Database Keys: + -eps_view - print information about the solver used . -eps_view_mat0 binary - save the first matrix (A) to the default binary viewer . -eps_view_mat1 binary - save the second matrix (B) to the default binary viewer - -eps_plot_eigs - plot computed eigenvalues Level: beginner .seealso: EPSCreate(), EPSSetUp(), EPSDestroy(), EPSSetTolerances() @*/ PetscErrorCode EPSSolve(EPS eps) { PetscErrorCode ierr; PetscInt i,nmat; PetscReal re,im; PetscScalar dot; PetscBool flg,iscayley; PetscViewer viewer; PetscViewerFormat format; PetscDraw draw; PetscDrawSP drawsp; STMatMode matmode; Mat A,B; Vec w,x; PetscFunctionBegin; PetscValidHeaderSpecific(eps,EPS_CLASSID,1); ierr = PetscLogEventBegin(EPS_Solve,eps,0,0,0);CHKERRQ(ierr); /* call setup */ ierr = EPSSetUp(eps);CHKERRQ(ierr); eps->nconv = 0; eps->its = 0; for (i=0;i<eps->ncv;i++) { eps->eigr[i] = 0.0; eps->eigi[i] = 0.0; eps->errest[i] = 0.0; } ierr = EPSMonitor(eps,eps->its,eps->nconv,eps->eigr,eps->eigi,eps->errest,eps->ncv);CHKERRQ(ierr); /* call solver */ ierr = (*eps->ops->solve)(eps);CHKERRQ(ierr); eps->state = EPS_STATE_SOLVED; ierr = STGetMatMode(eps->st,&matmode);CHKERRQ(ierr); if (matmode == ST_MATMODE_INPLACE && eps->ispositive) { /* Purify eigenvectors before reverting operator */ ierr = EPSComputeVectors(eps);CHKERRQ(ierr); } ierr = STPostSolve(eps->st);CHKERRQ(ierr); if (!eps->reason) SETERRQ(PetscObjectComm((PetscObject)eps),PETSC_ERR_PLIB,"Internal error, solver returned without setting converged reason"); /* Map eigenvalues back to the original problem, necessary in some * spectral transformations */ if (eps->ops->backtransform) { ierr = (*eps->ops->backtransform)(eps);CHKERRQ(ierr); } #if !defined(PETSC_USE_COMPLEX) /* reorder conjugate eigenvalues (positive imaginary first) */ for (i=0; i<eps->nconv-1; i++) { if (eps->eigi[i] != 0) { if (eps->eigi[i] < 0) { eps->eigi[i] = -eps->eigi[i]; eps->eigi[i+1] = -eps->eigi[i+1]; /* the next correction only works with eigenvectors */ ierr = EPSComputeVectors(eps);CHKERRQ(ierr); ierr = BVScaleColumn(eps->V,i+1,-1.0);CHKERRQ(ierr); } i++; } } #endif ierr = STGetNumMatrices(eps->st,&nmat);CHKERRQ(ierr); ierr = STGetOperators(eps->st,0,&A);CHKERRQ(ierr); if (nmat>1) { ierr = STGetOperators(eps->st,1,&B);CHKERRQ(ierr); } /* In the case of Cayley transform, eigenvectors need to be B-normalized */ ierr = PetscObjectTypeCompare((PetscObject)eps->st,STCAYLEY,&iscayley);CHKERRQ(ierr); if (iscayley && eps->isgeneralized && eps->ishermitian) { ierr = MatGetVecs(B,NULL,&w);CHKERRQ(ierr); ierr = EPSComputeVectors(eps);CHKERRQ(ierr); for (i=0;i<eps->nconv;i++) { ierr = BVGetColumn(eps->V,i,&x);CHKERRQ(ierr); ierr = MatMult(B,x,w);CHKERRQ(ierr); ierr = VecDot(w,x,&dot);CHKERRQ(ierr); ierr = VecScale(x,1.0/PetscSqrtScalar(dot));CHKERRQ(ierr); ierr = BVRestoreColumn(eps->V,i,&x);CHKERRQ(ierr); } ierr = VecDestroy(&w);CHKERRQ(ierr); } /* sort eigenvalues according to eps->which parameter */ ierr = SlepcSortEigenvalues(eps->sc,eps->nconv,eps->eigr,eps->eigi,eps->perm);CHKERRQ(ierr); ierr = PetscLogEventEnd(EPS_Solve,eps,0,0,0);CHKERRQ(ierr); /* various viewers */ ierr = MatViewFromOptions(A,((PetscObject)eps)->prefix,"-eps_view_mat0");CHKERRQ(ierr); if (nmat>1) { ierr = MatViewFromOptions(B,((PetscObject)eps)->prefix,"-eps_view_mat1");CHKERRQ(ierr); } ierr = PetscOptionsGetViewer(PetscObjectComm((PetscObject)eps),((PetscObject)eps)->prefix,"-eps_view",&viewer,&format,&flg);CHKERRQ(ierr); if (flg && !PetscPreLoadingOn) { ierr = PetscViewerPushFormat(viewer,format);CHKERRQ(ierr); ierr = EPSView(eps,viewer);CHKERRQ(ierr); ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); } flg = PETSC_FALSE; ierr = PetscOptionsGetBool(((PetscObject)eps)->prefix,"-eps_plot_eigs",&flg,NULL);CHKERRQ(ierr); if (flg) { ierr = PetscViewerDrawOpen(PETSC_COMM_SELF,0,"Computed Eigenvalues",PETSC_DECIDE,PETSC_DECIDE,300,300,&viewer);CHKERRQ(ierr); ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr); ierr = PetscDrawSPCreate(draw,1,&drawsp);CHKERRQ(ierr); for (i=0;i<eps->nconv;i++) { #if defined(PETSC_USE_COMPLEX) re = PetscRealPart(eps->eigr[i]); im = PetscImaginaryPart(eps->eigi[i]); #else re = eps->eigr[i]; im = eps->eigi[i]; #endif ierr = PetscDrawSPAddPoint(drawsp,&re,&im);CHKERRQ(ierr); } ierr = PetscDrawSPDraw(drawsp,PETSC_TRUE);CHKERRQ(ierr); ierr = PetscDrawSPDestroy(&drawsp);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); } /* Remove deflation and initial subspaces */ eps->nds = 0; eps->nini = 0; PetscFunctionReturn(0); }
int main(int argc,char **args) { User user; Mat A,S; PetscScalar *data,diag = 1.3; PetscReal tol = PETSC_SMALL; PetscInt i,j,m = PETSC_DECIDE,n = PETSC_DECIDE,M = 17,N = 15,s1,s2; PetscInt test, ntest = 2; PetscMPIInt rank,size; PetscBool nc = PETSC_FALSE, cong; PetscBool ronl = PETSC_TRUE; PetscBool randomize = PETSC_FALSE; PetscBool keep = PETSC_FALSE; PetscBool testzerorows = PETSC_TRUE, testdiagscale = PETSC_TRUE, testgetdiag = PETSC_TRUE; PetscBool testshift = PETSC_TRUE, testscale = PETSC_TRUE, testdup = PETSC_TRUE, testreset = PETSC_TRUE; PetscErrorCode ierr; ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr; ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-M",&M,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-N",&N,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-ml",&m,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-nl",&n,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,NULL,"-square_nc",&nc,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,NULL,"-rows_only",&ronl,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,NULL,"-randomize",&randomize,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,NULL,"-test_zerorows",&testzerorows,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,NULL,"-test_diagscale",&testdiagscale,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,NULL,"-test_getdiag",&testgetdiag,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,NULL,"-test_shift",&testshift,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,NULL,"-test_scale",&testscale,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,NULL,"-test_dup",&testdup,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,NULL,"-test_reset",&testreset,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-loop",&ntest,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetReal(NULL,NULL,"-tol",&tol,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,NULL,"-diag",&diag,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,NULL,"-keep",&keep,NULL);CHKERRQ(ierr); /* This tests square matrices with different row/col layout */ if (nc && size > 1) { M = PetscMax(PetscMax(N,M),1); N = M; m = n = 0; if (rank == 0) { m = M-1; n = 1; } else if (rank == 1) { m = 1; n = N-1; } } ierr = MatCreateDense(PETSC_COMM_WORLD,m,n,M,N,NULL,&A);CHKERRQ(ierr); ierr = MatGetLocalSize(A,&m,&n);CHKERRQ(ierr); ierr = MatGetSize(A,&M,&N);CHKERRQ(ierr); ierr = MatHasCongruentLayouts(A,&cong);CHKERRQ(ierr); ierr = MatGetOwnershipRange(A,&s1,NULL);CHKERRQ(ierr); s2 = 1; while (s2 < M) s2 *= 10; ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr); for (j = 0; j < N; j++) { for (i = 0; i < m; i++) { data[j*m + i] = s2*j + i + s1 + 1; } } ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatConvert(A,MATAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr); ierr = MatSetOption(A,MAT_KEEP_NONZERO_PATTERN,keep);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)A,"initial");CHKERRQ(ierr); ierr = MatViewFromOptions(A,NULL,"-view_mat");CHKERRQ(ierr); ierr = PetscNew(&user);CHKERRQ(ierr); ierr = MatCreateShell(PETSC_COMM_WORLD,m,n,M,N,user,&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); if (cong) { ierr = MatShellSetOperation(S,MATOP_GET_DIAGONAL,(void (*)(void))MatGetDiagonal_User);CHKERRQ(ierr); } ierr = MatDuplicate(A,MAT_COPY_VALUES,&user->B);CHKERRQ(ierr); /* Square and rows only scaling */ ronl = cong ? ronl : PETSC_TRUE; for (test = 0; test < ntest; test++) { PetscReal err; if (testzerorows) { Mat ST,B,C,BT,BTT; IS zr; Vec x = NULL, b1 = NULL, b2 = NULL; PetscInt *idxs = NULL, nr = 0; if (rank == (test%size)) { nr = 1; ierr = PetscMalloc1(nr,&idxs);CHKERRQ(ierr); if (test%2) { idxs[0] = (2*M - 1 - test/2)%M; } else { idxs[0] = (test/2)%M; } idxs[0] = PetscMax(idxs[0],0); } ierr = ISCreateGeneral(PETSC_COMM_WORLD,nr,idxs,PETSC_OWN_POINTER,&zr);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)zr,"ZR");CHKERRQ(ierr); ierr = ISViewFromOptions(zr,NULL,"-view_is");CHKERRQ(ierr); ierr = MatCreateVecs(A,&x,&b1);CHKERRQ(ierr); if (randomize) { ierr = VecSetRandom(x,NULL);CHKERRQ(ierr); ierr = VecSetRandom(b1,NULL);CHKERRQ(ierr); } else { ierr = VecSet(x,11.4);CHKERRQ(ierr); ierr = VecSet(b1,-14.2);CHKERRQ(ierr); } ierr = VecDuplicate(b1,&b2);CHKERRQ(ierr); ierr = VecCopy(b1,b2);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)b1,"A_B1");CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)b2,"A_B2");CHKERRQ(ierr); if (size > 1 && !cong) { /* MATMPIAIJ ZeroRows and ZeroRowsColumns are buggy in this case */ ierr = VecDestroy(&b1);CHKERRQ(ierr); } if (ronl) { ierr = MatZeroRowsIS(A,zr,diag,x,b1);CHKERRQ(ierr); ierr = MatZeroRowsIS(S,zr,diag,x,b2);CHKERRQ(ierr); } else { ierr = MatZeroRowsColumnsIS(A,zr,diag,x,b1);CHKERRQ(ierr); ierr = MatZeroRowsColumnsIS(S,zr,diag,x,b2);CHKERRQ(ierr); ierr = ISDestroy(&zr);CHKERRQ(ierr); /* Mix zerorows and zerorowscols */ nr = 0; idxs = NULL; if (!rank) { nr = 1; ierr = PetscMalloc1(nr,&idxs);CHKERRQ(ierr); if (test%2) { idxs[0] = (3*M - 2 - test/2)%M; } else { idxs[0] = (test/2+1)%M; } idxs[0] = PetscMax(idxs[0],0); } ierr = ISCreateGeneral(PETSC_COMM_WORLD,nr,idxs,PETSC_OWN_POINTER,&zr);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)zr,"ZR2");CHKERRQ(ierr); ierr = ISViewFromOptions(zr,NULL,"-view_is");CHKERRQ(ierr); ierr = MatZeroRowsIS(A,zr,diag*2.0+PETSC_SMALL,NULL,NULL);CHKERRQ(ierr); ierr = MatZeroRowsIS(S,zr,diag*2.0+PETSC_SMALL,NULL,NULL);CHKERRQ(ierr); } ierr = ISDestroy(&zr);CHKERRQ(ierr); if (b1) { Vec b; ierr = VecViewFromOptions(b1,NULL,"-view_b");CHKERRQ(ierr); ierr = VecViewFromOptions(b2,NULL,"-view_b");CHKERRQ(ierr); ierr = VecDuplicate(b1,&b);CHKERRQ(ierr); ierr = VecCopy(b1,b);CHKERRQ(ierr); ierr = VecAXPY(b,-1.0,b2);CHKERRQ(ierr); ierr = VecNorm(b,NORM_INFINITY,&err);CHKERRQ(ierr); if (err >= tol) { ierr = PetscPrintf(PETSC_COMM_WORLD,"[test %D] Error b %g\n",test,(double)err);CHKERRQ(ierr); } ierr = VecDestroy(&b);CHKERRQ(ierr); } ierr = VecDestroy(&b1);CHKERRQ(ierr); ierr = VecDestroy(&b2);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = MatConvert(S,MATDENSE,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr); ierr = MatCreateTranspose(S,&ST);CHKERRQ(ierr); ierr = MatComputeOperator(ST,MATDENSE,&BT);CHKERRQ(ierr); ierr = MatTranspose(BT,MAT_INITIAL_MATRIX,&BTT);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)B,"S");CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)BTT,"STT");CHKERRQ(ierr); ierr = MatConvert(A,MATDENSE,MAT_INITIAL_MATRIX,&C);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)C,"A");CHKERRQ(ierr); ierr = MatViewFromOptions(C,NULL,"-view_mat");CHKERRQ(ierr); ierr = MatViewFromOptions(B,NULL,"-view_mat");CHKERRQ(ierr); ierr = MatViewFromOptions(BTT,NULL,"-view_mat");CHKERRQ(ierr); ierr = MatAXPY(C,-1.0,B,SAME_NONZERO_PATTERN);CHKERRQ(ierr); ierr = MatNorm(C,NORM_FROBENIUS,&err);CHKERRQ(ierr); if (err >= tol) { ierr = PetscPrintf(PETSC_COMM_WORLD,"[test %D] Error mat mult %g\n",test,(double)err);CHKERRQ(ierr); } ierr = MatConvert(A,MATDENSE,MAT_REUSE_MATRIX,&C);CHKERRQ(ierr); ierr = MatAXPY(C,-1.0,BTT,SAME_NONZERO_PATTERN);CHKERRQ(ierr); ierr = MatNorm(C,NORM_FROBENIUS,&err);CHKERRQ(ierr); if (err >= tol) { ierr = PetscPrintf(PETSC_COMM_WORLD,"[test %D] Error mat mult transpose %g\n",test,(double)err);CHKERRQ(ierr); } ierr = MatDestroy(&ST);CHKERRQ(ierr); ierr = MatDestroy(&BTT);CHKERRQ(ierr); ierr = MatDestroy(&BT);CHKERRQ(ierr); ierr = MatDestroy(&B);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); } if (testdiagscale) { /* MatDiagonalScale() */ Vec vr,vl; ierr = MatCreateVecs(A,&vr,&vl);CHKERRQ(ierr); if (randomize) { ierr = VecSetRandom(vr,NULL);CHKERRQ(ierr); ierr = VecSetRandom(vl,NULL);CHKERRQ(ierr); } else { ierr = VecSet(vr,test%2 ? 0.15 : 1.0/0.15);CHKERRQ(ierr); ierr = VecSet(vl,test%2 ? -1.2 : 1.0/-1.2);CHKERRQ(ierr); } ierr = MatDiagonalScale(A,vl,vr);CHKERRQ(ierr); ierr = MatDiagonalScale(S,vl,vr);CHKERRQ(ierr); ierr = VecDestroy(&vr);CHKERRQ(ierr); ierr = VecDestroy(&vl);CHKERRQ(ierr); } if (testscale) { /* MatScale() */ ierr = MatScale(A,test%2 ? 1.4 : 1.0/1.4);CHKERRQ(ierr); ierr = MatScale(S,test%2 ? 1.4 : 1.0/1.4);CHKERRQ(ierr); } if (testshift && cong) { /* MatShift() : MATSHELL shift is broken when row/cols layout are not congruent and left/right scaling have been applied */ ierr = MatShift(A,test%2 ? -77.5 : 77.5);CHKERRQ(ierr); ierr = MatShift(S,test%2 ? -77.5 : 77.5);CHKERRQ(ierr); } if (testgetdiag && cong) { /* MatGetDiagonal() */ Vec dA,dS; ierr = MatCreateVecs(A,&dA,NULL);CHKERRQ(ierr); ierr = MatCreateVecs(S,&dS,NULL);CHKERRQ(ierr); ierr = MatGetDiagonal(A,dA);CHKERRQ(ierr); ierr = MatGetDiagonal(S,dS);CHKERRQ(ierr); ierr = VecAXPY(dA,-1.0,dS);CHKERRQ(ierr); ierr = VecNorm(dA,NORM_INFINITY,&err);CHKERRQ(ierr); if (err >= tol) { ierr = PetscPrintf(PETSC_COMM_WORLD,"[test %D] Error diag %g\n",test,(double)err);CHKERRQ(ierr); } ierr = VecDestroy(&dA);CHKERRQ(ierr); ierr = VecDestroy(&dS);CHKERRQ(ierr); } if (testdup && !test) { Mat A2, S2; ierr = MatDuplicate(A,MAT_COPY_VALUES,&A2);CHKERRQ(ierr); ierr = MatDuplicate(S,MAT_COPY_VALUES,&S2);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&S);CHKERRQ(ierr); A = A2; S = S2; } if (testreset && (ntest == 1 || test == ntest-2)) { /* reset MATSHELL */ ierr = MatAssemblyBegin(S,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(S,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* reset A */ ierr = MatCopy(user->B,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); } } ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&user->B);CHKERRQ(ierr); ierr = MatDestroy(&S);CHKERRQ(ierr); ierr = PetscFree(user);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }