/*
* time_step solves for the time_dependence of the system
* that was previously setup using the add_to_ham and add_lin
* routines. Solver selection and parameters can be controlled via PETSc
* command line options. Default solver is TSRK3BS
*
* Inputs:
* Vec x: The density matrix, with appropriate inital conditions
* double dt: initial timestep. For certain explicit methods, this timestep
* can be changed, as those methods have adaptive time steps
* double time_max: the maximum time to integrate to
* int steps_max: max number of steps to take
*/
void time_step(Vec x, PetscReal init_time, PetscReal time_max,PetscReal dt,PetscInt steps_max){
PetscViewer mat_view;
TS ts; /* timestepping context */
PetscInt i,j,Istart,Iend,steps,row,col;
PetscScalar mat_tmp;
PetscReal tmp_real;
Mat AA;
PetscInt nevents,direction;
PetscBool terminate;
operator op;
int num_pop;
double *populations;
Mat solve_A,solve_stiff_A;
PetscLogStagePop();
PetscLogStagePush(solve_stage);
if (_lindblad_terms) {
if (nid==0) {
printf("Lindblad terms found, using Lindblad solver.\n");
}
solve_A = full_A;
if (_stiff_solver) {
if(nid==0) printf("ERROR! Lindblad-stiff solver untested.");
exit(0);
}
} else {
if (nid==0) {
printf("No Lindblad terms found, using (more efficient) Schrodinger solver.\n");
}
solve_A = ham_A;
solve_stiff_A = ham_stiff_A;
if (_num_time_dep&&_stiff_solver) {
if(nid==0) printf("ERROR! Schrodinger-stiff + timedep solver untested.");
exit(0);
}
}
/* Possibly print dense ham. No stabilization is needed? */
if (nid==0) {
/* Print dense ham, if it was asked for */
if (_print_dense_ham){
FILE *fp_ham;
fp_ham = fopen("ham","w");
if (nid==0){
for (i=0;i<total_levels;i++){
for (j=0;j<total_levels;j++){
fprintf(fp_ham,"%e %e ",PetscRealPart(_hamiltonian[i][j]),PetscImaginaryPart(_hamiltonian[i][j]));
}
fprintf(fp_ham,"\n");
}
}
fclose(fp_ham);
for (i=0;i<total_levels;i++){
free(_hamiltonian[i]);
}
free(_hamiltonian);
_print_dense_ham = 0;
}
}
/* Remove stabilization if it was previously added */
if (stab_added){
if (nid==0) printf("Removing stabilization...\n");
/*
* We add 1.0 in the 0th spot and every n+1 after
*/
if (nid==0) {
row = 0;
for (i=0;i<total_levels;i++){
col = i*(total_levels+1);
mat_tmp = -1.0 + 0.*PETSC_i;
MatSetValue(full_A,row,col,mat_tmp,ADD_VALUES);
}
}
}
MatGetOwnershipRange(solve_A,&Istart,&Iend);
/*
* Explicitly add 0.0 to all diagonal elements;
* this fixes a 'matrix in wrong state' message that PETSc
* gives if the diagonal was never initialized.
*/
//if (nid==0) printf("Adding 0 to diagonal elements...\n");
for (i=Istart;i<Iend;i++){
mat_tmp = 0 + 0.*PETSC_i;
MatSetValue(solve_A,i,i,mat_tmp,ADD_VALUES);
}
if(_stiff_solver){
MatGetOwnershipRange(solve_stiff_A,&Istart,&Iend);
for (i=Istart;i<Iend;i++){
mat_tmp = 0 + 0.*PETSC_i;
MatSetValue(solve_stiff_A,i,i,mat_tmp,ADD_VALUES);
}
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*
* Create the timestepping solver and set various options *
*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
* Create timestepping solver context
*/
TSCreate(PETSC_COMM_WORLD,&ts);
TSSetProblemType(ts,TS_LINEAR);
/*
* Set function to get information at every timestep
*/
if (_ts_monitor!=NULL){
TSMonitorSet(ts,_ts_monitor,_tsctx,NULL);
}
/*
* Set up ODE system
*/
TSSetRHSFunction(ts,NULL,TSComputeRHSFunctionLinear,NULL);
if(_stiff_solver) {
/* TSSetIFunction(ts,NULL,TSComputeRHSFunctionLinear,NULL); */
if (nid==0) {
printf("Stiff solver not implemented!\n");
exit(0);
}
if(nid==0) printf("Using stiff solver - TSROSW\n");
}
if(_num_time_dep+_num_time_dep_lin) {
for(i=0;i<_num_time_dep;i++){
tmp_real = 0.0;
_add_ops_to_mat_ham(tmp_real,solve_A,_time_dep_list[i].num_ops,_time_dep_list[i].ops);
}
for(i=0;i<_num_time_dep_lin;i++){
tmp_real = 0.0;
_add_ops_to_mat_lin(tmp_real,solve_A,_time_dep_list_lin[i].num_ops,_time_dep_list_lin[i].ops);
}
/* Tell PETSc to assemble the matrix */
MatAssemblyBegin(solve_A,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(solve_A,MAT_FINAL_ASSEMBLY);
if (nid==0) printf("Matrix Assembled.\n");
MatDuplicate(solve_A,MAT_COPY_VALUES,&AA);
MatAssemblyBegin(AA,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(AA,MAT_FINAL_ASSEMBLY);
TSSetRHSJacobian(ts,AA,AA,_RHS_time_dep_ham_p,NULL);
} else {
/* Tell PETSc to assemble the matrix */
MatAssemblyBegin(solve_A,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(solve_A,MAT_FINAL_ASSEMBLY);
if (_stiff_solver){
MatAssemblyBegin(solve_stiff_A,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(solve_stiff_A,MAT_FINAL_ASSEMBLY);
/* TSSetIJacobian(ts,solve_stiff_A,solve_stiff_A,TSComputeRHSJacobianConstant,NULL); */
if (nid==0) {
printf("Stiff solver not implemented!\n");
exit(0);
}
}
if (nid==0) printf("Matrix Assembled.\n");
TSSetRHSJacobian(ts,solve_A,solve_A,TSComputeRHSJacobianConstant,NULL);
}
/* Print information about the matrix. */
PetscViewerASCIIOpen(PETSC_COMM_WORLD,NULL,&mat_view);
PetscViewerPushFormat(mat_view,PETSC_VIEWER_ASCII_INFO);
/* PetscViewerPushFormat(mat_view,PETSC_VIEWER_ASCII_MATLAB); */
/* MatView(solve_A,mat_view); */
/* PetscInt ncols; */
/* const PetscInt *cols; */
/* const PetscScalar *vals; */
/* for(i=0;i<total_levels*total_levels;i++){ */
/* MatGetRow(solve_A,i,&ncols,&cols,&vals); */
/* for (j=0;j<ncols;j++){ */
/* if(PetscAbsComplex(vals[j])>1e-5){ */
/* printf("%d %d %lf %lf\n",i,cols[j],vals[j]); */
/* } */
/* } */
/* MatRestoreRow(solve_A,i,&ncols,&cols,&vals); */
/* } */
if(_stiff_solver){
MatView(solve_stiff_A,mat_view);
}
PetscViewerPopFormat(mat_view);
PetscViewerDestroy(&mat_view);
TSSetTimeStep(ts,dt);
/*
* Set default options, can be changed at runtime
*/
TSSetMaxSteps(ts,steps_max);
TSSetMaxTime(ts,time_max);
TSSetTime(ts,init_time);
TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);
if (_stiff_solver) {
TSSetType(ts,TSROSW);
} else {
TSSetType(ts,TSRK);
TSRKSetType(ts,TSRK3BS);
}
/* If we have gates to apply, set up the event handler. */
if (_num_quantum_gates > 0) {
nevents = 1; //Only one event for now (did we cross a gate?)
direction = -1; //We only want to count an event if we go from positive to negative
terminate = PETSC_FALSE; //Keep time stepping after we passed our event
/* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate,
* a function to check event status, a function to apply events, private data context.
*/
TSSetEventHandler(ts,nevents,&direction,&terminate,_QG_EventFunction,_QG_PostEventFunction,NULL);
}
if (_num_circuits > 0) {
nevents = 1; //Only one event for now (did we cross a gate?)
direction = -1; //We only want to count an event if we go from positive to negative
terminate = PETSC_FALSE; //Keep time stepping after we passed our event
/* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate,
* a function to check event status, a function to apply events, private data context.
*/
TSSetEventHandler(ts,nevents,&direction,&terminate,_QC_EventFunction,_QC_PostEventFunction,NULL);
}
if (_discrete_ec > 0) {
nevents = 1; //Only one event for now (did we cross an ec step?)
direction = -1; //We only want to count an event if we go from positive to negative
terminate = PETSC_FALSE; //Keep time stepping after we passed our event
/* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate,
* a function to check event status, a function to apply events, private data context.
*/
TSSetEventHandler(ts,nevents,&direction,&terminate,_DQEC_EventFunction,_DQEC_PostEventFunction,NULL);
}
/* if (_lindblad_terms) { */
/* nevents = 1; //Only one event for now (did we cross a gate?) */
/* direction = 0; //We only want to count an event if we go from positive to negative */
/* terminate = PETSC_FALSE; //Keep time stepping after we passed our event */
/* TSSetEventHandler(ts,nevents,&direction,&terminate,_Normalize_EventFunction,_Normalize_PostEventFunction,NULL); */
/* } */
TSSetFromOptions(ts);
TSSolve(ts,x);
TSGetStepNumber(ts,&steps);
num_pop = get_num_populations();
populations = malloc(num_pop*sizeof(double));
get_populations(x,&populations);
/* if(nid==0){ */
/* printf("Final populations: "); */
/* for(i=0;i<num_pop;i++){ */
/* printf(" %e ",populations[i]); */
/* } */
/* printf("\n"); */
/* } */
/* PetscPrintf(PETSC_COMM_WORLD,"Steps %D\n",steps); */
/* Free work space */
TSDestroy(&ts);
if(_num_time_dep+_num_time_dep_lin){
MatDestroy(&AA);
}
free(populations);
PetscLogStagePop();
PetscLogStagePush(post_solve_stage);
return;
}
int main(int argc,char **argv)
{
Mat A,B,C,D;
PetscInt i,M=10,N=5,j,nrows,ncols,am,an,rstart,rend;
PetscErrorCode ierr;
PetscRandom r;
PetscBool equal,iselemental;
PetscReal fill = 1.0;
IS isrows,iscols;
const PetscInt *rows,*cols;
PetscScalar *v,rval;
#if defined(PETSC_HAVE_ELEMENTAL)
PetscBool Test_MatMatMult=PETSC_TRUE;
#else
PetscBool Test_MatMatMult=PETSC_FALSE;
#endif
PetscMPIInt size;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return 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 = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&r);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(r);CHKERRQ(ierr);
/* Set local matrix entries */
ierr = MatGetOwnershipIS(A,&isrows,&iscols);CHKERRQ(ierr);
ierr = ISGetLocalSize(isrows,&nrows);CHKERRQ(ierr);
ierr = ISGetIndices(isrows,&rows);CHKERRQ(ierr);
ierr = ISGetLocalSize(iscols,&ncols);CHKERRQ(ierr);
ierr = ISGetIndices(iscols,&cols);CHKERRQ(ierr);
ierr = PetscMalloc1(nrows*ncols,&v);CHKERRQ(ierr);
for (i=0; i<nrows; i++) {
for (j=0; j<ncols; j++) {
ierr = PetscRandomGetValue(r,&rval);CHKERRQ(ierr);
v[i*ncols+j] = rval;
}
}
ierr = MatSetValues(A,nrows,rows,ncols,cols,v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = ISRestoreIndices(isrows,&rows);CHKERRQ(ierr);
ierr = ISRestoreIndices(iscols,&cols);CHKERRQ(ierr);
ierr = ISDestroy(&isrows);CHKERRQ(ierr);
ierr = ISDestroy(&iscols);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&r);CHKERRQ(ierr);
/* Test MatTranspose() */
ierr = MatCreateTranspose(A,&C);CHKERRQ(ierr);
ierr = MatTranspose(A,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr); /* B = A^T */
ierr = MatMultEqual(C,B,10,&equal);CHKERRQ(ierr);
if (!equal) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"A^T*x != (x^T*A)^T");
ierr = MatTranspose(A,MAT_REUSE_MATRIX,&B);CHKERRQ(ierr); /* B = A^T */
ierr = MatMultEqual(C,B,10,&equal);CHKERRQ(ierr);
if (!equal) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"A^T*x != (x^T*A)^T");
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
ierr = MatTranspose(B,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
ierr = MatMultEqual(C,B,10,&equal);CHKERRQ(ierr);
if (!equal) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"A^T*x != (x^T*A)^T");
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
/* Test MatMatMult() */
if (Test_MatMatMult) {
#if !defined(PETSC_HAVE_ELEMENTAL)
if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"This test requires ELEMENTAL");
#endif
ierr = MatTranspose(A,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr); /* B = A^T */
ierr = MatMatMult(B,A,MAT_INITIAL_MATRIX,fill,&C);CHKERRQ(ierr); /* C = B*A = A^T*A */
ierr = MatMatMult(B,A,MAT_REUSE_MATRIX,fill,&C);CHKERRQ(ierr);
/* Test MatDuplicate for matrix product */
ierr = MatDuplicate(C,MAT_COPY_VALUES,&D);CHKERRQ(ierr);
ierr = MatDestroy(&D);CHKERRQ(ierr);
/* Test B*A*x = C*x for n random vector x */
ierr = MatMatMultEqual(B,A,C,10,&equal);CHKERRQ(ierr);
if (!equal) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"B*A*x != C*x");
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatMatMultSymbolic(B,A,fill,&C);CHKERRQ(ierr);
for (i=0; i<2; i++) {
/* Repeat the numeric product to test reuse of the previous symbolic product */
ierr = MatMatMultNumeric(B,A,C);CHKERRQ(ierr);
ierr = MatMatMultEqual(B,A,C,10,&equal);CHKERRQ(ierr);
if (!equal) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"B*A*x != C*x");
}
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
}
/* Test MatTransposeMatMult() */
ierr = PetscObjectTypeCompare((PetscObject)A,MATELEMENTAL,&iselemental);CHKERRQ(ierr);
if (!iselemental) {
ierr = MatTransposeMatMult(A,A,MAT_INITIAL_MATRIX,fill,&D);CHKERRQ(ierr); /* D = A^T*A */
ierr = MatTransposeMatMult(A,A,MAT_REUSE_MATRIX,fill,&D);CHKERRQ(ierr);
/* Test MatDuplicate for matrix product */
ierr = MatDuplicate(D,MAT_COPY_VALUES,&C);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
/* ierr = MatView(D,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); */
ierr = MatTransposeMatMultEqual(A,A,D,10,&equal);CHKERRQ(ierr);
if (!equal) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"D*x != A^T*A*x");
ierr = MatDestroy(&D);CHKERRQ(ierr);
/* Test D*x = A^T*C*A*x, where C is in AIJ format */
ierr = MatGetLocalSize(A,&am,&an);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
if (size == 1) {
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,am,am);CHKERRQ(ierr);
} else {
ierr = MatSetSizes(C,am,am,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
}
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C,&rstart,&rend);CHKERRQ(ierr);
v[0] = 1.0;
for (i=rstart; i<rend; i++) {
ierr = MatSetValues(C,1,&i,1,&i,v,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* B = C*A, D = A^T*B */
ierr = MatMatMult(C,A,MAT_INITIAL_MATRIX,1.0,&B);CHKERRQ(ierr);
ierr = MatTransposeMatMult(A,B,MAT_INITIAL_MATRIX,fill,&D);CHKERRQ(ierr);
ierr = MatTransposeMatMultEqual(A,B,D,10,&equal);CHKERRQ(ierr);
if (!equal) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"D*x != A^T*B*x");
ierr = MatDestroy(&D);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
}
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscFree(v);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **args)
{
Vec x,b,u; /* approx solution, RHS, exact solution */
Mat A; /* linear system matrix */
KSP ksp; /* KSP context */
KSP *subksp; /* array of local KSP contexts on this processor */
PC pc; /* PC context */
PC subpc; /* PC context for subdomain */
PetscReal norm; /* norm of solution error */
PetscErrorCode ierr;
PetscInt i,j,Ii,J,*blks,m = 8,n;
PetscMPIInt rank,size;
PetscInt its,nlocal,first,Istart,Iend;
PetscScalar v,one = 1.0,none = -1.0;
PetscTruth isbjacobi,flg = PETSC_FALSE;
PetscInitialize(&argc,&args,(char *)0,help);
ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
n = m+2;
/* -------------------------------------------------------------------
Compute the matrix and right-hand-side vector that define
the linear system, Ax = b.
------------------------------------------------------------------- */
/*
Create and assemble parallel matrix
*/
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
for (Ii=Istart; Ii<Iend; Ii++) {
v = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {J = Ii - n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (i<m-1) {J = Ii + n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j>0) {J = Ii - 1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j<n-1) {J = Ii + 1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
v = 4.0; ierr = MatSetValues(A,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/*
Create parallel vectors
*/
ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr);
ierr = VecSetSizes(u,PETSC_DECIDE,m*n);CHKERRQ(ierr);
ierr = VecSetFromOptions(u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b);CHKERRQ(ierr);
ierr = VecDuplicate(b,&x);CHKERRQ(ierr);
/*
Set exact solution; then compute right-hand-side vector.
*/
ierr = VecSet(u,one);CHKERRQ(ierr);
ierr = MatMult(A,u,b);CHKERRQ(ierr);
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
*/
ierr = KSPSetOperators(ksp,A,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
/*
Set default preconditioner for this program to be block Jacobi.
This choice can be overridden at runtime with the option
-pc_type <type>
*/
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCBJACOBI);CHKERRQ(ierr);
/* -------------------------------------------------------------------
Define the problem decomposition
------------------------------------------------------------------- */
/*
Call PCBJacobiSetTotalBlocks() to set individually the size of
each block in the preconditioner. This could also be done with
the runtime option
-pc_bjacobi_blocks <blocks>
Also, see the command PCBJacobiSetLocalBlocks() to set the
local blocks.
Note: The default decomposition is 1 block per processor.
*/
ierr = PetscMalloc(m*sizeof(PetscInt),&blks);CHKERRQ(ierr);
for (i=0; i<m; i++) blks[i] = n;
ierr = PCBJacobiSetTotalBlocks(pc,m,blks);CHKERRQ(ierr);
ierr = PetscFree(blks);CHKERRQ(ierr);
/* -------------------------------------------------------------------
Set the linear solvers for the subblocks
------------------------------------------------------------------- */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Basic method, should be sufficient for the needs of most users.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
By default, the block Jacobi method uses the same solver on each
block of the problem. To set the same solver options on all blocks,
use the prefix -sub before the usual PC and KSP options, e.g.,
-sub_pc_type <pc> -sub_ksp_type <ksp> -sub_ksp_rtol 1.e-4
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Advanced method, setting different solvers for various blocks.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Note that each block's KSP context is completely independent of
the others, and the full range of uniprocessor KSP options is
available for each block. The following section of code is intended
to be a simple illustration of setting different linear solvers for
the individual blocks. These choices are obviously not recommended
for solving this particular problem.
*/
ierr = PetscTypeCompare((PetscObject)pc,PCBJACOBI,&isbjacobi);CHKERRQ(ierr);
if (isbjacobi) {
/*
Call KSPSetUp() to set the block Jacobi data structures (including
creation of an internal KSP context for each block).
Note: KSPSetUp() MUST be called before PCBJacobiGetSubKSP().
*/
ierr = KSPSetUp(ksp);CHKERRQ(ierr);
/*
Extract the array of KSP contexts for the local blocks
*/
ierr = PCBJacobiGetSubKSP(pc,&nlocal,&first,&subksp);CHKERRQ(ierr);
/*
Loop over the local blocks, setting various KSP options
for each block.
*/
for (i=0; i<nlocal; i++) {
ierr = KSPGetPC(subksp[i],&subpc);CHKERRQ(ierr);
if (!rank) {
if (i%2) {
ierr = PCSetType(subpc,PCILU);CHKERRQ(ierr);
} else {
ierr = PCSetType(subpc,PCNONE);CHKERRQ(ierr);
ierr = KSPSetType(subksp[i],KSPBCGS);CHKERRQ(ierr);
ierr = KSPSetTolerances(subksp[i],1.e-6,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr);
}
} else {
ierr = PCSetType(subpc,PCJACOBI);CHKERRQ(ierr);
ierr = KSPSetType(subksp[i],KSPGMRES);CHKERRQ(ierr);
ierr = KSPSetTolerances(subksp[i],1.e-7,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr);
}
}
}
/* -------------------------------------------------------------------
Solve the linear system
------------------------------------------------------------------- */
/*
Set runtime options
*/
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
/*
Solve the linear system
*/
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
/*
View info about the solver
*/
ierr = PetscOptionsGetTruth(PETSC_NULL,"-nokspview",&flg,PETSC_NULL);CHKERRQ(ierr);
if (!flg) {
ierr = KSPView(ksp,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
/* -------------------------------------------------------------------
Check solution and clean up
------------------------------------------------------------------- */
/*
Check the error
*/
ierr = VecAXPY(x,none,u);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %A iterations %D\n",norm,its);CHKERRQ(ierr);
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = KSPDestroy(ksp);CHKERRQ(ierr);
ierr = VecDestroy(u);CHKERRQ(ierr); ierr = VecDestroy(x);CHKERRQ(ierr);
ierr = VecDestroy(b);CHKERRQ(ierr); ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
void
construct_operator(Elliptic1D* p, int levels) {
// Start out with a simple tridiagonal matrix.
// problem solves laplacian u = -1 on -1 to 1 with homogeneous
// dirichlet boundary conditions. Code
// implements a finite difference to approximate this
// equation system.
p->levels = levels;
p->npoints = (2<<levels)-1;
p->num_seg = 2<<levels;
PetscScalar h = 2./p->num_seg;
MatCreateMPIAIJ(PETSC_COMM_WORLD,
PETSC_DECIDE, //number of local rows
PETSC_DECIDE, //number of local cols
p->npoints, //global rows
p->npoints, //global cols
3, // upper bound of diagonal nnz per row
PETSC_NULL, // array of diagonal nnz per row
1, // upper bound of off-processor nnz per row
PETSC_NULL, // array of off-processor nnz per row
&p->A); // matrix
MatSetFromOptions(p->A);
PetscInt start;
PetscInt end;
MatGetOwnershipRange(p->A, &start, &end);
int ii;
for (ii=start; ii<end; ii++) {
PetscInt col_index[3] = {ii-1, ii, ii+1};
PetscInt row_index = ii;
PetscScalar stencil[3] = {-1./(h*h), 2./(h*h), -1./(h*h)};
// handle corner cases at beginning and end of matrix.
if (ii+1 == p->npoints) {
col_index[2] = -1;
} else if (ii == 0) {
col_index[0] = -1;
}
MatSetValues(p->A, 1, &row_index, 3, col_index, stencil, INSERT_VALUES);
}
MatAssemblyBegin(p->A, MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(p->A, MAT_FINAL_ASSEMBLY);
//Create the corresponding vectors
VecCreateMPI(PETSC_COMM_WORLD,
PETSC_DECIDE,
p->npoints,
&p->x
);
VecSetFromOptions(p->x);
VecDuplicate(p->x, &p->b);
VecSet(p->b, 1);
VecZeroEntries(p->x);
//Fill in a random initial guess
PetscInt high;
PetscInt low;
VecGetOwnershipRange(p->x, &low, &high);
for (ii=low; ii<high; ii++) {
VecSetValue(p->x, ii, frand(), INSERT_VALUES);
}
VecAssemblyBegin(p->x);
VecAssemblyEnd(p->x);
}
int main(int argc,char **args) {
PetscErrorCode ierr;
Vec x, b, xexact;
Mat A;
KSP ksp;
int m = 4, i, Istart, Iend, j[3];
double v[3], xval, errnorm;
PetscInitialize(&argc,&args,NULL,help);
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,"tri_","options for tri",""); CHKERRQ(ierr);
ierr = PetscOptionsInt("-m","dimension of linear system","tri.c",m,&m,NULL); CHKERRQ(ierr);
ierr = PetscOptionsEnd(); CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&x); CHKERRQ(ierr);
ierr = VecSetSizes(x,PETSC_DECIDE,m); CHKERRQ(ierr);
ierr = VecSetFromOptions(x); CHKERRQ(ierr);
ierr = VecDuplicate(x,&b); CHKERRQ(ierr);
ierr = VecDuplicate(x,&xexact); CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A); CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,m,m); CHKERRQ(ierr);
ierr = MatSetOptionsPrefix(A,"a_"); CHKERRQ(ierr);
ierr = MatSetFromOptions(A); CHKERRQ(ierr);
ierr = MatSetUp(A); CHKERRQ(ierr);
//ENDSETUP
ierr = MatGetOwnershipRange(A,&Istart,&Iend); CHKERRQ(ierr);
for (i=Istart; i<Iend; i++) {
if (i == 0) {
v[0] = 3.0; v[1] = -1.0;
j[0] = 0; j[1] = 1;
ierr = MatSetValues(A,1,&i,2,j,v,INSERT_VALUES); CHKERRQ(ierr);
} else {
v[0] = -1.0; v[1] = 3.0; v[2] = -1.0;
j[0] = i-1; j[1] = i; j[2] = i+1;
if (i == m-1) {
ierr = MatSetValues(A,1,&i,2,j,v,INSERT_VALUES); CHKERRQ(ierr);
} else {
ierr = MatSetValues(A,1,&i,3,j,v,INSERT_VALUES); CHKERRQ(ierr);
}
}
xval = exp(cos(i));
ierr = VecSetValues(xexact,1,&i,&xval,INSERT_VALUES); CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
ierr = VecAssemblyBegin(xexact); CHKERRQ(ierr);
ierr = VecAssemblyEnd(xexact); CHKERRQ(ierr);
ierr = MatMult(A,xexact,b); CHKERRQ(ierr);
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp); CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,A,A); CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp); CHKERRQ(ierr);
ierr = KSPSolve(ksp,b,x); CHKERRQ(ierr);
ierr = VecAXPY(x,-1.0,xexact); CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&errnorm); CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,
"error for m = %d system is |x-xexact|_2 = %.1e\n",m,errnorm); CHKERRQ(ierr);
KSPDestroy(&ksp); MatDestroy(&A);
VecDestroy(&x); VecDestroy(&b); VecDestroy(&xexact);
PetscFinalize();
return 0;
}
/*@
KSPComputeEigenvaluesExplicitly - Computes all of the eigenvalues of the
preconditioned operator using LAPACK.
Collective on KSP
Input Parameter:
+ ksp - iterative context obtained from KSPCreate()
- n - size of arrays r and c
Output Parameters:
+ r - real part of computed eigenvalues
- c - complex part of computed eigenvalues
Notes:
This approach is very slow but will generally provide accurate eigenvalue
estimates. This routine explicitly forms a dense matrix representing
the preconditioned operator, and thus will run only for relatively small
problems, say n < 500.
Many users may just want to use the monitoring routine
KSPMonitorSingularValue() (which can be set with option -ksp_monitor_singular_value)
to print the singular values at each iteration of the linear solve.
The preconditoner operator, rhs vector, solution vectors should be
set before this routine is called. i.e use KSPSetOperators(),KSPSolve() or
KSPSetOperators()
Level: advanced
.keywords: KSP, compute, eigenvalues, explicitly
.seealso: KSPComputeEigenvalues(), KSPMonitorSingularValue(), KSPComputeExtremeSingularValues(), KSPSetOperators(), KSPSolve()
@*/
PetscErrorCode KSPComputeEigenvaluesExplicitly(KSP ksp,PetscInt nmax,PetscReal *r,PetscReal *c)
{
Mat BA;
PetscErrorCode ierr;
PetscMPIInt size,rank;
MPI_Comm comm = ((PetscObject)ksp)->comm;
PetscScalar *array;
Mat A;
PetscInt m,row,nz,i,n,dummy;
const PetscInt *cols;
const PetscScalar *vals;
PetscFunctionBegin;
ierr = KSPComputeExplicitOperator(ksp,&BA);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MatGetSize(BA,&n,&n);CHKERRQ(ierr);
if (size > 1) { /* assemble matrix on first processor */
ierr = MatCreate(((PetscObject)ksp)->comm,&A);CHKERRQ(ierr);
if (!rank) {
ierr = MatSetSizes(A,n,n,n,n);CHKERRQ(ierr);
} else {
ierr = MatSetSizes(A,0,0,n,n);CHKERRQ(ierr);
}
ierr = MatSetType(A,MATMPIDENSE);CHKERRQ(ierr);
ierr = MatMPIDenseSetPreallocation(A,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParent(BA,A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(BA,&row,&dummy);CHKERRQ(ierr);
ierr = MatGetLocalSize(BA,&m,&dummy);CHKERRQ(ierr);
for (i=0; i<m; i++) {
ierr = MatGetRow(BA,row,&nz,&cols,&vals);CHKERRQ(ierr);
ierr = MatSetValues(A,1,&row,nz,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(BA,row,&nz,&cols,&vals);CHKERRQ(ierr);
row++;
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatDenseGetArray(A,&array);CHKERRQ(ierr);
} else {
ierr = MatDenseGetArray(BA,&array);CHKERRQ(ierr);
}
#if defined(PETSC_HAVE_ESSL)
/* ESSL has a different calling sequence for dgeev() and zgeev() than standard LAPACK */
if (!rank) {
PetscScalar sdummy,*cwork;
PetscReal *work,*realpart;
PetscBLASInt clen,idummy,lwork,bn,zero = 0;
PetscInt *perm;
#if !defined(PETSC_USE_COMPLEX)
clen = n;
#else
clen = 2*n;
#endif
ierr = PetscMalloc(clen*sizeof(PetscScalar),&cwork);CHKERRQ(ierr);
idummy = -1; /* unused */
bn = PetscBLASIntCast(n);
lwork = 5*n;
ierr = PetscMalloc(lwork*sizeof(PetscReal),&work);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscReal),&realpart);CHKERRQ(ierr);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
LAPACKgeev_(&zero,array,&bn,cwork,&sdummy,&idummy,&idummy,&bn,work,&lwork);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
/* For now we stick with the convention of storing the real and imaginary
components of evalues separately. But is this what we really want? */
ierr = PetscMalloc(n*sizeof(PetscInt),&perm);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
for (i=0; i<n; i++) {
realpart[i] = cwork[2*i];
perm[i] = i;
}
ierr = PetscSortRealWithPermutation(n,realpart,perm);CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = cwork[2*perm[i]];
c[i] = cwork[2*perm[i]+1];
}
#else
for (i=0; i<n; i++) {
realpart[i] = PetscRealPart(cwork[i]);
perm[i] = i;
}
ierr = PetscSortRealWithPermutation(n,realpart,perm);CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = PetscRealPart(cwork[perm[i]]);
c[i] = PetscImaginaryPart(cwork[perm[i]]);
}
#endif
ierr = PetscFree(perm);CHKERRQ(ierr);
ierr = PetscFree(realpart);CHKERRQ(ierr);
ierr = PetscFree(cwork);CHKERRQ(ierr);
}
#elif !defined(PETSC_USE_COMPLEX)
if (!rank) {
PetscScalar *work;
PetscReal *realpart,*imagpart;
PetscBLASInt idummy,lwork;
PetscInt *perm;
idummy = n;
lwork = 5*n;
ierr = PetscMalloc(2*n*sizeof(PetscReal),&realpart);CHKERRQ(ierr);
imagpart = realpart + n;
ierr = PetscMalloc(5*n*sizeof(PetscReal),&work);CHKERRQ(ierr);
#if defined(PETSC_MISSING_LAPACK_GEEV)
SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_SUP,"GEEV - Lapack routine is unavailable\nNot able to provide eigen values.");
#else
{
PetscBLASInt lierr;
PetscScalar sdummy;
PetscBLASInt bn = PetscBLASIntCast(n);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
LAPACKgeev_("N","N",&bn,array,&bn,realpart,imagpart,&sdummy,&idummy,&sdummy,&idummy,work,&lwork,&lierr);
if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in LAPACK routine %d",(int)lierr);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
}
#endif
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscInt),&perm);CHKERRQ(ierr);
for (i=0; i<n; i++) { perm[i] = i;}
ierr = PetscSortRealWithPermutation(n,realpart,perm);CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = realpart[perm[i]];
c[i] = imagpart[perm[i]];
}
ierr = PetscFree(perm);CHKERRQ(ierr);
ierr = PetscFree(realpart);CHKERRQ(ierr);
}
#else
if (!rank) {
PetscScalar *work,*eigs;
PetscReal *rwork;
PetscBLASInt idummy,lwork;
PetscInt *perm;
idummy = n;
lwork = 5*n;
ierr = PetscMalloc(5*n*sizeof(PetscScalar),&work);CHKERRQ(ierr);
ierr = PetscMalloc(2*n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscScalar),&eigs);CHKERRQ(ierr);
#if defined(PETSC_MISSING_LAPACK_GEEV)
SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_SUP,"GEEV - Lapack routine is unavailable\nNot able to provide eigen values.");
#else
{
PetscBLASInt lierr;
PetscScalar sdummy;
PetscBLASInt nb = PetscBLASIntCast(n);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
LAPACKgeev_("N","N",&nb,array,&nb,eigs,&sdummy,&idummy,&sdummy,&idummy,work,&lwork,rwork,&lierr);
if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in LAPACK routine %d",(int)lierr);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
}
#endif
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscFree(rwork);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscInt),&perm);CHKERRQ(ierr);
for (i=0; i<n; i++) { perm[i] = i;}
for (i=0; i<n; i++) { r[i] = PetscRealPart(eigs[i]);}
ierr = PetscSortRealWithPermutation(n,r,perm);CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = PetscRealPart(eigs[perm[i]]);
c[i] = PetscImaginaryPart(eigs[perm[i]]);
}
ierr = PetscFree(perm);CHKERRQ(ierr);
ierr = PetscFree(eigs);CHKERRQ(ierr);
}
#endif
if (size > 1) {
ierr = MatDenseRestoreArray(A,&array);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
} else {
ierr = MatDenseRestoreArray(BA,&array);CHKERRQ(ierr);
}
ierr = MatDestroy(&BA);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main( int argc, char **argv )
{
Mat A; /* operator matrix */
Vec x;
EPS eps; /* eigenproblem solver context */
const EPSType type;
PetscReal error, tol, re, im;
PetscScalar kr, ki;
PetscErrorCode ierr;
PetscInt N, n=10, m, i, j, II, Istart, Iend, nev, maxit, its, nconv;
PetscScalar w;
PetscBool flag;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,&flag);CHKERRQ(ierr);
if(!flag) m=n;
N = n*m;
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nFiedler vector of a 2-D regular mesh, N=%d (%dx%d grid)\n\n",N,n,m);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the operator matrix that defines the eigensystem, Ax=kx
In this example, A = L(G), where L is the Laplacian of graph G, i.e.
Lii = degree of node i, Lij = -1 if edge (i,j) exists in G
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,N,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
for( II=Istart; II<Iend; II++ ) {
i = II/n; j = II-i*n;
w = 0.0;
if(i>0) { ierr = MatSetValue(A,II,II-n,-1.0,INSERT_VALUES);CHKERRQ(ierr); w=w+1.0; }
if(i<m-1) { ierr = MatSetValue(A,II,II+n,-1.0,INSERT_VALUES);CHKERRQ(ierr); w=w+1.0; }
if(j>0) { ierr = MatSetValue(A,II,II-1,-1.0,INSERT_VALUES);CHKERRQ(ierr); w=w+1.0; }
if(j<n-1) { ierr = MatSetValue(A,II,II+1,-1.0,INSERT_VALUES);CHKERRQ(ierr); w=w+1.0; }
ierr = MatSetValue(A,II,II,w,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create eigensolver context
*/
ierr = EPSCreate(PETSC_COMM_WORLD,&eps);CHKERRQ(ierr);
/*
Set operators. In this case, it is a standard eigenvalue problem
*/
ierr = EPSSetOperators(eps,A,PETSC_NULL);CHKERRQ(ierr);
ierr = EPSSetProblemType(eps,EPS_HEP);CHKERRQ(ierr);
/*
Select portion of spectrum
*/
ierr = EPSSetWhichEigenpairs(eps,EPS_SMALLEST_REAL);CHKERRQ(ierr);
/*
Set solver parameters at runtime
*/
ierr = EPSSetFromOptions(eps);CHKERRQ(ierr);
/*
Attach deflation space: in this case, the matrix has a constant
nullspace, [1 1 ... 1]^T is the eigenvector of the zero eigenvalue
*/
ierr = MatGetVecs(A,&x,PETSC_NULL);CHKERRQ(ierr);
ierr = VecSet(x,1.0);CHKERRQ(ierr);
ierr = EPSSetDeflationSpace(eps,1,&x);CHKERRQ(ierr);
ierr = VecDestroy(x);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the eigensystem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = EPSSolve(eps);CHKERRQ(ierr);
ierr = EPSGetIterationNumber(eps, &its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %d\n",its);CHKERRQ(ierr);
/*
Optional: Get some information from the solver and display it
*/
ierr = EPSGetType(eps,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Solution method: %s\n\n",type);CHKERRQ(ierr);
ierr = EPSGetDimensions(eps,&nev,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of requested eigenvalues: %d\n",nev);CHKERRQ(ierr);
ierr = EPSGetTolerances(eps,&tol,&maxit);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Stopping condition: tol=%.4g, maxit=%d\n",tol,maxit);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Get number of converged approximate eigenpairs
*/
ierr = EPSGetConverged(eps,&nconv);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of converged approximate eigenpairs: %d\n\n",nconv);
CHKERRQ(ierr);
if (nconv>0) {
/*
Display eigenvalues and relative errors
*/
ierr = PetscPrintf(PETSC_COMM_WORLD,
" k ||Ax-kx||/||kx||\n"
" ----------------- ------------------\n" );CHKERRQ(ierr);
for( i=0; i<nconv; i++ ) {
/*
Get converged eigenpairs: i-th eigenvalue is stored in kr (real part) and
ki (imaginary part)
*/
ierr = EPSGetEigenpair(eps,i,&kr,&ki,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
/*
Compute the relative error associated to each eigenpair
*/
ierr = EPSComputeRelativeError(eps,i,&error);CHKERRQ(ierr);
#ifdef PETSC_USE_COMPLEX
re = PetscRealPart(kr);
im = PetscImaginaryPart(kr);
#else
re = kr;
im = ki;
#endif
if (im!=0.0) {
ierr = PetscPrintf(PETSC_COMM_WORLD," %9f%+9f j %12g\n",re,im,error);CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_WORLD," %12f %12g\n",re,error);CHKERRQ(ierr);
}
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n" );CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = EPSDestroy(eps);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **args)
{
Vec x,b,u; /* approx solution, RHS, exact solution */
Mat A; /* linear system matrix */
KSP ksp; /* linear solver context */
PetscReal norm; /* norm of solution error */
PetscInt dim,i,j,Ii,J,Istart,Iend,n = 6,its,use_random;
PetscErrorCode ierr;
PetscScalar v,none = -1.0,sigma2,pfive = 0.5,*xa;
PetscRandom rctx;
PetscReal h2,sigma1 = 100.0;
PetscTruth flg = PETSC_FALSE;
PetscInitialize(&argc,&args,(char *)0,help);
#if !defined(PETSC_USE_COMPLEX)
SETERRQ(1,"This example requires complex numbers");
#endif
ierr = PetscOptionsGetReal(PETSC_NULL,"-sigma1",&sigma1,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
dim = n*n;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrix and right-hand-side vector that define
the linear system, Ax = b.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create parallel matrix, specifying only its global dimensions.
When using MatCreate(), the matrix format can be specified at
runtime. Also, the parallel partitioning of the matrix is
determined by PETSc at runtime.
*/
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,dim,dim);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
/*
Currently, all PETSc parallel matrix formats are partitioned by
contiguous chunks of rows across the processors. Determine which
rows of the matrix are locally owned.
*/
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
/*
Set matrix elements in parallel.
- Each processor needs to insert only elements that it owns
locally (but any non-local elements will be sent to the
appropriate processor during matrix assembly).
- Always specify global rows and columns of matrix entries.
*/
ierr = PetscOptionsGetTruth(PETSC_NULL,"-norandom",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) use_random = 0;
else use_random = 1;
if (use_random) {
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = PetscRandomSetInterval(rctx,0.0,PETSC_i);CHKERRQ(ierr);
} else {
sigma2 = 10.0*PETSC_i;
}
h2 = 1.0/((n+1)*(n+1));
for (Ii=Istart; Ii<Iend; Ii++) {
v = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {
J = Ii-n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (i<n-1) {
J = Ii+n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j>0) {
J = Ii-1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j<n-1) {
J = Ii+1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (use_random) {ierr = PetscRandomGetValue(rctx,&sigma2);CHKERRQ(ierr);}
v = 4.0 - sigma1*h2 + sigma2*h2;
ierr = MatSetValues(A,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
if (use_random) {ierr = PetscRandomDestroy(rctx);CHKERRQ(ierr);}
/*
Assemble matrix, using the 2-step process:
MatAssemblyBegin(), MatAssemblyEnd()
Computations can be done while messages are in transition
by placing code between these two statements.
*/
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/*
Create parallel vectors.
- When using VecCreate(), VecSetSizes() and VecSetFromOptions(),
we specify only the vector's global
dimension; the parallel partitioning is determined at runtime.
- Note: We form 1 vector from scratch and then duplicate as needed.
*/
ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr);
ierr = VecSetSizes(u,PETSC_DECIDE,dim);CHKERRQ(ierr);
ierr = VecSetFromOptions(u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b);CHKERRQ(ierr);
ierr = VecDuplicate(b,&x);CHKERRQ(ierr);
/*
Set exact solution; then compute right-hand-side vector.
*/
if (use_random) {
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = VecSetRandom(u,rctx);CHKERRQ(ierr);
} else {
ierr = VecSet(u,pfive);CHKERRQ(ierr);
}
ierr = MatMult(A,u,b);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the linear solver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
*/
ierr = KSPSetOperators(ksp,A,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
/*
Set runtime options, e.g.,
-ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
*/
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Print the first 3 entries of x; this demonstrates extraction of the
real and imaginary components of the complex vector, x.
*/
flg = PETSC_FALSE;
ierr = PetscOptionsGetTruth(PETSC_NULL,"-print_x3",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) {
ierr = VecGetArray(x,&xa);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"The first three entries of x are:\n");CHKERRQ(ierr);
for (i=0; i<3; i++){
ierr = PetscPrintf(PETSC_COMM_WORLD,"x[%D] = %G + %G i\n",i,PetscRealPart(xa[i]),PetscImaginaryPart(xa[i]));CHKERRQ(ierr);
}
ierr = VecRestoreArray(x,&xa);CHKERRQ(ierr);
}
/*
Check the error
*/
ierr = VecAXPY(x,none,u);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %A iterations %D\n",norm,its);CHKERRQ(ierr);
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = KSPDestroy(ksp);CHKERRQ(ierr);
if (use_random) {ierr = PetscRandomDestroy(rctx);CHKERRQ(ierr);}
ierr = VecDestroy(u);CHKERRQ(ierr); ierr = VecDestroy(x);CHKERRQ(ierr);
ierr = VecDestroy(b);CHKERRQ(ierr); ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscInt time_steps=100,iout,NOUT=1;
PetscMPIInt size;
Vec global;
PetscReal dt,ftime,ftime_original;
TS ts;
PetscViewer viewfile;
Mat J = 0;
Vec x;
Data data;
PetscInt mn;
PetscBool flg;
MatColoring mc;
ISColoring iscoloring;
MatFDColoring matfdcoloring = 0;
PetscBool fd_jacobian_coloring = PETSC_FALSE;
SNES snes;
KSP ksp;
PC pc;
PetscViewer viewer;
char pcinfo[120],tsinfo[120];
TSType tstype;
PetscBool sundials;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
/* set data */
data.m = 9;
data.n = 9;
data.a = 1.0;
data.epsilon = 0.1;
data.dx = 1.0/(data.m+1.0);
data.dy = 1.0/(data.n+1.0);
mn = (data.m)*(data.n);
ierr = PetscOptionsGetInt(NULL,"-time",&time_steps,NULL);CHKERRQ(ierr);
/* set initial conditions */
ierr = VecCreate(PETSC_COMM_WORLD,&global);CHKERRQ(ierr);
ierr = VecSetSizes(global,PETSC_DECIDE,mn);CHKERRQ(ierr);
ierr = VecSetFromOptions(global);CHKERRQ(ierr);
ierr = Initial(global,&data);CHKERRQ(ierr);
ierr = VecDuplicate(global,&x);CHKERRQ(ierr);
/* create timestep context */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSMonitorSet(ts,Monitor,&data,NULL);CHKERRQ(ierr);
#if defined(PETSC_HAVE_SUNDIALS)
ierr = TSSetType(ts,TSSUNDIALS);CHKERRQ(ierr);
#else
ierr = TSSetType(ts,TSEULER);CHKERRQ(ierr);
#endif
dt = 0.1;
ftime_original = data.tfinal = 1.0;
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSSetDuration(ts,time_steps,ftime_original);CHKERRQ(ierr);
ierr = TSSetSolution(ts,global);CHKERRQ(ierr);
/* set user provided RHSFunction and RHSJacobian */
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&data);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr);
ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,mn,mn);CHKERRQ(ierr);
ierr = MatSetFromOptions(J);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(J,5,NULL);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(J,5,NULL,5,NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-ts_fd",&flg);CHKERRQ(ierr);
if (!flg) {
ierr = TSSetRHSJacobian(ts,J,J,RHSJacobian,&data);CHKERRQ(ierr);
} else {
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-fd_color",&fd_jacobian_coloring);CHKERRQ(ierr);
if (fd_jacobian_coloring) { /* Use finite differences with coloring */
/* Get data structure of J */
PetscBool pc_diagonal;
ierr = PetscOptionsHasName(NULL,"-pc_diagonal",&pc_diagonal);CHKERRQ(ierr);
if (pc_diagonal) { /* the preconditioner of J is a diagonal matrix */
PetscInt rstart,rend,i;
PetscScalar zero=0.0;
ierr = MatGetOwnershipRange(J,&rstart,&rend);CHKERRQ(ierr);
for (i=rstart; i<rend; i++) {
ierr = MatSetValues(J,1,&i,1,&i,&zero,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
} else {
/* Fill the structure using the expensive SNESComputeJacobianDefault. Temporarily set up the TS so we can call this function */
ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
ierr = TSSetUp(ts);CHKERRQ(ierr);
ierr = SNESComputeJacobianDefault(snes,x,J,J,ts);CHKERRQ(ierr);
}
/* create coloring context */
ierr = MatColoringCreate(J,&mc);CHKERRQ(ierr);
ierr = MatColoringSetType(mc,MATCOLORINGSL);CHKERRQ(ierr);
ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr);
ierr = MatColoringApply(mc,&iscoloring);CHKERRQ(ierr);
ierr = MatColoringDestroy(&mc);CHKERRQ(ierr);
ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(matfdcoloring,(PetscErrorCode (*)(void))SNESTSFormFunction,ts);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(J,iscoloring,matfdcoloring);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefaultColor,matfdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
} else { /* Use finite differences (slow) */
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefault,NULL);CHKERRQ(ierr);
}
}
/* Pick up a Petsc preconditioner */
/* one can always set method or preconditioner during the run time */
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetKSP(snes,&ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSetUp(ts);CHKERRQ(ierr);
/* Test TSSetPostStep() */
ierr = PetscOptionsHasName(NULL,"-test_PostStep",&flg);CHKERRQ(ierr);
if (flg) {
ierr = TSSetPostStep(ts,PostStep);CHKERRQ(ierr);
}
ierr = PetscOptionsGetInt(NULL,"-NOUT",&NOUT,NULL);CHKERRQ(ierr);
for (iout=1; iout<=NOUT; iout++) {
ierr = TSSetDuration(ts,time_steps,iout*ftime_original/NOUT);CHKERRQ(ierr);
ierr = TSSolve(ts,global);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,ftime,dt);CHKERRQ(ierr);
}
/* Interpolate solution at tfinal */
ierr = TSGetSolution(ts,&global);CHKERRQ(ierr);
ierr = TSInterpolate(ts,ftime_original,global);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-matlab_view",&flg);CHKERRQ(ierr);
if (flg) { /* print solution into a MATLAB file */
ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,"out.m",&viewfile);CHKERRQ(ierr);
ierr = PetscViewerSetFormat(viewfile,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
ierr = VecView(global,viewfile);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewfile);CHKERRQ(ierr);
}
/* display solver info for Sundials */
ierr = TSGetType(ts,&tstype);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)ts,TSSUNDIALS,&sundials);CHKERRQ(ierr);
if (sundials) {
ierr = PetscViewerStringOpen(PETSC_COMM_WORLD,tsinfo,120,&viewer);CHKERRQ(ierr);
ierr = TSView(ts,viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = PetscViewerStringOpen(PETSC_COMM_WORLD,pcinfo,120,&viewer);CHKERRQ(ierr);
ierr = PCView(pc,viewer);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"%d Procs,%s TSType, %s Preconditioner\n",size,tsinfo,pcinfo);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
/* free the memories */
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = VecDestroy(&global);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
if (fd_jacobian_coloring) {ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr);}
ierr = PetscFinalize();
return 0;
}
/*
* Test that the matrix is calculated correctly on the cannonical triangle.
* Tests against the analytical solution calculated by hand.
*/
void TestAssembler() throw(Exception)
{
QuadraticMesh<2> mesh;
TrianglesMeshReader<2,2> mesh_reader("mesh/test/data/canonical_triangle_quadratic", 2, 2, false);
mesh.ConstructFromMeshReader(mesh_reader);
double mu = 2.0;
c_vector<double,2> body_force;
double g1 = 1.34254;
double g2 = 75.3422;
body_force(0) = g1;
body_force(1) = g2;
StokesFlowProblemDefinition<2> problem_defn(mesh);
problem_defn.SetViscosity(mu);
problem_defn.SetBodyForce(body_force);
StokesFlowAssembler<2> assembler(&mesh, &problem_defn);
// The tests below test the assembler against hand-calculated variables for
// an OLD weak form (corresponding to different boundary conditions), not the
// current Stokes weak form. This factor converts the assembler to use the old
// weak form. See documentation for this variable for more details.
assembler.mScaleFactor = 0.0;
Vec vec = PetscTools::CreateVec(18);
Mat mat;
PetscTools::SetupMat(mat, 18, 18, 18);
assembler.SetVectorToAssemble(vec, true);
assembler.SetMatrixToAssemble(mat, true);
assembler.Assemble();
PetscMatTools::Finalise(mat);
double A[6][6] = {
{ 1.0, 1.0/6.0, 1.0/6.0, 0.0, -2.0/3.0, -2.0/3.0},
{ 1.0/6.0, 1.0/2.0, 0.0, 0.0, 0.0, -2.0/3.0},
{ 1.0/6.0, 0.0, 1.0/2.0, 0.0, -2.0/3.0, 0.0},
{ 0.0, 0.0, 0.0, 8.0/3.0, -4.0/3.0, -4.0/3.0},
{ -2.0/3.0, 0.0, -2.0/3.0, -4.0/3.0, 8.0/3.0, 0.0},
{ -2.0/3.0, -2.0/3.0, 0.0, -4.0/3.0, 0.0, 8.0/3.0}
};
double Bx[6][3] = {
{ -1.0/6.0, 0.0, 0.0},
{ 0.0, 1.0/6.0, 0.0},
{ 0.0, 0.0, 0.0},
{ 1.0/6.0, 1.0/6.0, 1.0/3.0},
{ -1.0/6.0, -1.0/6.0, -1.0/3.0},
{ 1.0/6.0, -1.0/6.0, 0.0},
};
double By[6][3] = {
{ -1.0/6.0, 0.0, 0.0},
{ 0.0, 0.0, 0.0},
{ 0.0, 0.0, 1.0/6.0},
{ 1.0/6.0, 1.0/3.0, 1.0/6.0},
{ 1.0/6.0, 0.0, -1.0/6.0},
{ -1.0/6.0, -1.0/3.0, -1.0/6.0},
};
c_matrix<double,18,18> exact_A = zero_matrix<double>(18);
// The diagonal 6x6 blocks
for (unsigned i=0; i<6; i++)
{
for (unsigned j=0; j<6; j++)
{
exact_A(3*i, 3*j) = mu*A[i][j];
exact_A(3*i+1,3*j+1) = mu*A[i][j];
}
}
// The 6x3 Blocks
for (unsigned i=0; i<6; i++)
{
for (unsigned j=0; j<3; j++)
{
exact_A(3*i,3*j+2) = -Bx[i][j];
exact_A(3*i+1,3*j+2) = -By[i][j];
//- as -Div(U)=0
exact_A(3*j+2,3*i) = -Bx[i][j];
exact_A(3*j+2,3*i+1) = -By[i][j];
}
}
int lo, hi;
MatGetOwnershipRange(mat, &lo, &hi);
for (unsigned i=lo; i<(unsigned)hi; i++)
{
for (unsigned j=0; j<18; j++)
{
TS_ASSERT_DELTA(PetscMatTools::GetElement(mat,i,j), exact_A(i,j), 1e-9);
}
}
ReplicatableVector vec_repl(vec);
// The first 6 entries in the vector correspond to nodes 0, 1, 2, i.e. the vertices.
// For these nodes, it can be shown that the integral of the corresponding
// basis function is zero, i.e. \intgl_{canonical element} \phi_i dV = 0.0 for i=0,1,2, phi_i the
// i-th QUADRATIC basis.
for(unsigned i=0; i<3; i++)
{
TS_ASSERT_DELTA(vec_repl[3*i], g1*0.0, 1e-8);
TS_ASSERT_DELTA(vec_repl[3*i+1], g2*0.0, 1e-8);
}
// The next 6 entries in the vector correspond to nodes 3, 4, 5, i.e. the internal edges.
// For these nodes, it can be shown that the integral of the corresponding
// basis function is 1/6, i.e. \intgl_{canonical element} \phi_i dV = 1/6 for i=3,4,5, phi_i the
// i-th QUADRATIC basis.
for(unsigned i=3; i<6; i++)
{
TS_ASSERT_DELTA(vec_repl[3*i], g1/6.0, 1e-8);
TS_ASSERT_DELTA(vec_repl[3*i+1], g2/6.0, 1e-8);
}
// The pressure-block of the RHS vector should be zero.
TS_ASSERT_DELTA(vec_repl[2], 0.0, 1e-9);
TS_ASSERT_DELTA(vec_repl[5], 0.0, 1e-9);
TS_ASSERT_DELTA(vec_repl[8], 0.0, 1e-9);
TS_ASSERT_DELTA(vec_repl[11], 0.0, 1e-9);
TS_ASSERT_DELTA(vec_repl[14], 0.0, 1e-9);
TS_ASSERT_DELTA(vec_repl[17], 0.0, 1e-9);
// Replace the body force with a functional body force (see MyBodyForce) above, and
// assemble the vector again. This bit isn't so much to test the vector, but
// to test the physical location being integrated at is interpolated correctly
// and passed into the force function - see asserts in MyBodyForce.
mesh.Translate(0.5, 0.8);
Vec vec2 = PetscTools::CreateVec(18);
assembler.SetVectorToAssemble(vec2, true);
problem_defn.SetBodyForce(MyBodyForce);
assembler.Assemble();
ReplicatableVector vec_repl2(vec2);
for(unsigned i=3; i<6; i++)
{
TS_ASSERT_DELTA(vec_repl2[3*i], 10.0/6.0, 1e-8);
TS_ASSERT_DELTA(vec_repl2[3*i+1], 20.0/6.0, 1e-8);
}
PetscTools::Destroy(vec);
PetscTools::Destroy(vec2);
PetscTools::Destroy(mat);
}
PetscErrorCode FormTestMatrix(Mat A,PetscInt n,TestType type)
{
#if !defined(PETSC_USE_COMPLEX)
SETERRQ(((PetscObject)A)->comm,1,"FormTestMatrix: These problems require complex numbers.");
#else
PetscScalar val[5];
PetscErrorCode ierr;
PetscInt i,j,Ii,J,col[5],Istart,Iend;
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
if (type == TEST_1) {
val[0] = 1.0; val[1] = 4.0; val[2] = -2.0;
for (i=1; i<n-1; i++) {
col[0] = i-1; col[1] = i; col[2] = i+1;
ierr = MatSetValues(A,1,&i,3,col,val,INSERT_VALUES);CHKERRQ(ierr);
}
i = n-1; col[0] = n-2; col[1] = n-1;
ierr = MatSetValues(A,1,&i,2,col,val,INSERT_VALUES);CHKERRQ(ierr);
i = 0; col[0] = 0; col[1] = 1; val[0] = 4.0; val[1] = -2.0;
ierr = MatSetValues(A,1,&i,2,col,val,INSERT_VALUES);CHKERRQ(ierr);
}
else if (type == TEST_2) {
val[0] = 1.0; val[1] = 0.0; val[2] = 2.0; val[3] = 1.0;
for (i=2; i<n-1; i++) {
col[0] = i-2; col[1] = i-1; col[2] = i; col[3] = i+1;
ierr = MatSetValues(A,1,&i,4,col,val,INSERT_VALUES);CHKERRQ(ierr);
}
i = n-1; col[0] = n-3; col[1] = n-2; col[2] = n-1;
ierr = MatSetValues(A,1,&i,3,col,val,INSERT_VALUES);CHKERRQ(ierr);
i = 1; col[0] = 0; col[1] = 1; col[2] = 2;
ierr = MatSetValues(A,1,&i,3,col,&val[1],INSERT_VALUES);CHKERRQ(ierr);
i = 0;
ierr = MatSetValues(A,1,&i,2,col,&val[2],INSERT_VALUES);CHKERRQ(ierr);
}
else if (type == TEST_3) {
val[0] = PETSC_i * 2.0;
val[1] = 4.0; val[2] = 0.0; val[3] = 1.0; val[4] = 0.7;
for (i=1; i<n-3; i++) {
col[0] = i-1; col[1] = i; col[2] = i+1; col[3] = i+2; col[4] = i+3;
ierr = MatSetValues(A,1,&i,5,col,val,INSERT_VALUES);CHKERRQ(ierr);
}
i = n-3; col[0] = n-4; col[1] = n-3; col[2] = n-2; col[3] = n-1;
ierr = MatSetValues(A,1,&i,4,col,val,INSERT_VALUES);CHKERRQ(ierr);
i = n-2; col[0] = n-3; col[1] = n-2; col[2] = n-1;
ierr = MatSetValues(A,1,&i,3,col,val,INSERT_VALUES);CHKERRQ(ierr);
i = n-1; col[0] = n-2; col[1] = n-1;
ierr = MatSetValues(A,1,&i,2,col,val,INSERT_VALUES);CHKERRQ(ierr);
i = 0; col[0] = 0; col[1] = 1; col[2] = 2; col[3] = 3;
ierr = MatSetValues(A,1,&i,4,col,&val[1],INSERT_VALUES);CHKERRQ(ierr);
}
else if (type == HELMHOLTZ_1) {
/* Problem domain: unit square: (0,1) x (0,1)
Solve Helmholtz equation:
-delta u - sigma1*u + i*sigma2*u = f,
where delta = Laplace operator
Dirichlet b.c.'s on all sides
*/
PetscRandom rctx;
PetscReal h2,sigma1 = 5.0;
PetscScalar sigma2;
ierr = PetscOptionsGetReal(PETSC_NULL,"-sigma1",&sigma1,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = PetscRandomSetInterval(rctx,0.0,PETSC_i);CHKERRQ(ierr);
h2 = 1.0/((n+1)*(n+1));
for (Ii=Istart; Ii<Iend; Ii++) {
*val = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {
J = Ii-n; ierr = MatSetValues(A,1,&Ii,1,&J,val,ADD_VALUES);CHKERRQ(ierr);}
if (i<n-1) {
J = Ii+n; ierr = MatSetValues(A,1,&Ii,1,&J,val,ADD_VALUES);CHKERRQ(ierr);}
if (j>0) {
J = Ii-1; ierr = MatSetValues(A,1,&Ii,1,&J,val,ADD_VALUES);CHKERRQ(ierr);}
if (j<n-1) {
J = Ii+1; ierr = MatSetValues(A,1,&Ii,1,&J,val,ADD_VALUES);CHKERRQ(ierr);}
ierr = PetscRandomGetValue(rctx,&sigma2);CHKERRQ(ierr);
*val = 4.0 - sigma1*h2 + sigma2*h2;
ierr = MatSetValues(A,1,&Ii,1,&Ii,val,ADD_VALUES);CHKERRQ(ierr);
}
ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);
}
else if (type == HELMHOLTZ_2) {
/* Problem domain: unit square: (0,1) x (0,1)
Solve Helmholtz equation:
-delta u - sigma1*u = f,
where delta = Laplace operator
Dirichlet b.c.'s on 3 sides
du/dn = i*alpha*u on (1,y), 0<y<1
*/
PetscReal h2,sigma1 = 200.0;
PetscScalar alpha_h;
ierr = PetscOptionsGetReal(PETSC_NULL,"-sigma1",&sigma1,PETSC_NULL);CHKERRQ(ierr);
h2 = 1.0/((n+1)*(n+1));
alpha_h = (PETSC_i * 10.0) / (PetscReal)(n+1); /* alpha_h = alpha * h */
for (Ii=Istart; Ii<Iend; Ii++) {
*val = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {
J = Ii-n; ierr = MatSetValues(A,1,&Ii,1,&J,val,ADD_VALUES);CHKERRQ(ierr);}
if (i<n-1) {
J = Ii+n; ierr = MatSetValues(A,1,&Ii,1,&J,val,ADD_VALUES);CHKERRQ(ierr);}
if (j>0) {
J = Ii-1; ierr = MatSetValues(A,1,&Ii,1,&J,val,ADD_VALUES);CHKERRQ(ierr);}
if (j<n-1) {
J = Ii+1; ierr = MatSetValues(A,1,&Ii,1,&J,val,ADD_VALUES);CHKERRQ(ierr);}
*val = 4.0 - sigma1*h2;
if (!((Ii+1)%n)) *val += alpha_h;
ierr = MatSetValues(A,1,&Ii,1,&Ii,val,ADD_VALUES);CHKERRQ(ierr);
}
}
else SETERRQ(((PetscObject)A)->comm,1,"FormTestMatrix: unknown test matrix type");
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
#endif
return 0;
}
int main(int argc,char **args)
{
Mat C;
PetscScalar v,none = -1.0;
PetscInt i,j,Ii,J,Istart,Iend,N,m = 4,n = 4,its,k;
PetscErrorCode ierr;
PetscMPIInt size,rank;
PetscReal err_norm,res_norm,err_tol=1.e-7,res_tol=1.e-6;
Vec x,b,u,u_tmp;
PetscRandom r;
PC pc;
KSP ksp;
PetscInitialize(&argc,&args,(char*)0,help);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-m",&m,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
N = m*n;
/* Generate matrix */
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,N,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C,&Istart,&Iend);CHKERRQ(ierr);
for (Ii=Istart; Ii<Iend; Ii++) {
v = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {J = Ii - n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (i<m-1) {J = Ii + n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j>0) {J = Ii - 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j<n-1) {J = Ii + 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
v = 4.0; ierr = MatSetValues(C,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* a shift can make C indefinite. Preconditioners LU, ILU (for BAIJ format) and ICC may fail */
/* ierr = MatShift(C,alpha);CHKERRQ(ierr); */
/* ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); */
/* Setup and solve for system */
/* Create vectors. */
ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr);
ierr = VecSetSizes(x,PETSC_DECIDE,N);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&b);CHKERRQ(ierr);
ierr = VecDuplicate(x,&u);CHKERRQ(ierr);
ierr = VecDuplicate(x,&u_tmp);CHKERRQ(ierr);
/* Set exact solution u; then compute right-hand-side vector b. */
ierr = PetscRandomCreate(PETSC_COMM_SELF,&r);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(r);CHKERRQ(ierr);
ierr = VecSetRandom(u,r);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&r);CHKERRQ(ierr);
ierr = MatMult(C,u,b);CHKERRQ(ierr);
for (k=0; k<3; k++) {
if (k == 0) { /* CG */
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,C,C);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n CG: \n");CHKERRQ(ierr);
ierr = KSPSetType(ksp,KSPCG);CHKERRQ(ierr);
} else if (k == 1) { /* MINRES */
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,C,C);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n MINRES: \n");CHKERRQ(ierr);
ierr = KSPSetType(ksp,KSPMINRES);CHKERRQ(ierr);
} else { /* SYMMLQ */
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,C,C);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n SYMMLQ: \n");CHKERRQ(ierr);
ierr = KSPSetType(ksp,KSPSYMMLQ);CHKERRQ(ierr);
}
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
/* ierr = PCSetType(pc,PCICC);CHKERRQ(ierr); */
ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr);
ierr = KSPSetTolerances(ksp,1.e-7,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr);
/*
Set runtime options, e.g.,
-ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
These options will override those specified above as long as
KSPSetFromOptions() is called _after_ any other customization
routines.
*/
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
/* Solve linear system; */
ierr = KSPSetUp(ksp);CHKERRQ(ierr);
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
/* Check error */
ierr = VecCopy(u,u_tmp);CHKERRQ(ierr);
ierr = VecAXPY(u_tmp,none,x);CHKERRQ(ierr);
ierr = VecNorm(u_tmp,NORM_2,&err_norm);CHKERRQ(ierr);
ierr = MatMult(C,x,u_tmp);CHKERRQ(ierr);
ierr = VecAXPY(u_tmp,none,b);CHKERRQ(ierr);
ierr = VecNorm(u_tmp,NORM_2,&res_norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Number of iterations = %3D\n",its);CHKERRQ(ierr);
if (res_norm > res_tol) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Residual norm %g;",(double)res_norm);CHKERRQ(ierr);
}
if (err_norm > err_tol) {
ierr = PetscPrintf(PETSC_COMM_WORLD," Error norm %g.\n",(double)err_norm);CHKERRQ(ierr);
}
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
}
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&u_tmp);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **args)
{
Mat C,A;
PetscInt i,j,m = 3,n = 2,Ii,J,rstart,rend,nz;
PetscMPIInt rank,size;
PetscErrorCode ierr;
const PetscInt *idx;
PetscScalar v;
const PetscScalar *values;
PetscInitialize(&argc,&args,(char*)0,help);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
n = 2*size;
/* create the matrix for the five point stencil, YET AGAIN*/
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(C,5,NULL,5,NULL);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(C,5,NULL);CHKERRQ(ierr);
for (i=0; i<m; i++) {
for (j=2*rank; j<2*rank+2; j++) {
v = -1.0; Ii = j + n*i;
if (i>0) {J = Ii - n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
if (i<m-1) {J = Ii + n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
if (j>0) {J = Ii - 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
if (j<n-1) {J = Ii + 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
v = 4.0; ierr = MatSetValues(C,1,&Ii,1,&Ii,&v,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr);
ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C,&rstart,&rend);CHKERRQ(ierr);
for (i=rstart; i<rend; i++) {
ierr = MatGetRow(C,i,&nz,&idx,&values);CHKERRQ(ierr);
ierr = PetscSynchronizedFPrintf(PETSC_COMM_WORLD,stdout,"[%d] get row %D: ",rank,i);CHKERRQ(ierr);
for (j=0; j<nz; j++) {
ierr = PetscSynchronizedFPrintf(PETSC_COMM_WORLD,stdout,"%D %G ",idx[j],PetscRealPart(values[j]));CHKERRQ(ierr);
}
ierr = PetscSynchronizedFPrintf(PETSC_COMM_WORLD,stdout,"\n");CHKERRQ(ierr);
ierr = MatRestoreRow(C,i,&nz,&idx,&values);CHKERRQ(ierr);
}
ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,stdout);CHKERRQ(ierr);CHKERRQ(ierr);
ierr = MatConvert(C,MATSAME,MAT_INITIAL_MATRIX,&A);CHKERRQ(ierr);
ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
/*
* steady_state solves for the steady_state of the system
* that was previously setup using the add_to_ham and add_lin
* routines. Solver selection and parameterscan be controlled via PETSc
* command line options.
*/
void steady_state(Vec x){
PetscViewer mat_view;
PC pc;
Vec b;
KSP ksp; /* linear solver context */
PetscInt row,col,its,j,i,Istart,Iend;
PetscScalar mat_tmp;
long dim;
int num_pop;
double *populations;
Mat solve_A;
if (_lindblad_terms) {
dim = total_levels*total_levels;
solve_A = full_A;
if (nid==0) {
printf("Lindblad terms found, using Lindblad solver.");
}
} else {
if (nid==0) {
printf("Warning! Steady state not supported for Schrodinger.\n");
printf(" Defaulting to (less efficient) Lindblad Solver\n");
exit(0);
}
dim = total_levels*total_levels;
solve_A = ham_A;
}
if (!stab_added){
if (nid==0) printf("Adding stabilization...\n");
/*
* Add elements to the matrix to make the normalization work
* I have no idea why this works, I am copying it from qutip
* We add 1.0 in the 0th spot and every n+1 after
*/
if (nid==0) {
row = 0;
for (i=0;i<total_levels;i++){
col = i*(total_levels+1);
mat_tmp = 1.0 + 0.*PETSC_i;
MatSetValue(full_A,row,col,mat_tmp,ADD_VALUES);
}
/* Print dense ham, if it was asked for */
if (_print_dense_ham){
FILE *fp_ham;
fp_ham = fopen("ham","w");
if (nid==0){
for (i=0;i<total_levels;i++){
for (j=0;j<total_levels;j++){
fprintf(fp_ham,"%e %e ",PetscRealPart(_hamiltonian[i][j]),PetscImaginaryPart(_hamiltonian[i][j]));
}
fprintf(fp_ham,"\n");
}
}
fclose(fp_ham);
for (i=0;i<total_levels;i++){
free(_hamiltonian[i]);
}
free(_hamiltonian);
_print_dense_ham = 0;
}
}
stab_added = 1;
}
// if (!matrix_assembled) {
MatGetOwnershipRange(full_A,&Istart,&Iend);
/*
* Explicitly add 0.0 to all diagonal elements;
* this fixes a 'matrix in wrong state' message that PETSc
* gives if the diagonal was never initialized.
*/
if (nid==0) printf("Adding 0 to diagonal elements...\n");
for (i=Istart;i<Iend;i++){
mat_tmp = 0 + 0.*PETSC_i;
MatSetValue(full_A,i,i,mat_tmp,ADD_VALUES);
}
/* Tell PETSc to assemble the matrix */
MatAssemblyBegin(full_A,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(full_A,MAT_FINAL_ASSEMBLY);
if (nid==0) printf("Matrix Assembled.\n");
matrix_assembled = 1;
// }
/* Print information about the matrix. */
PetscViewerASCIIOpen(PETSC_COMM_WORLD,NULL,&mat_view);
PetscViewerPushFormat(mat_view,PETSC_VIEWER_ASCII_INFO);
MatView(full_A,mat_view);
PetscViewerPopFormat(mat_view);
PetscViewerDestroy(&mat_view);
/*
* Create parallel vectors.
* - When using VecCreate(), VecSetSizes() and VecSetFromOptions(),
* we specify only the vector's global
* dimension; the parallel partitioning is determined at runtime.
* - Note: We form 1 vector from scratch and then duplicate as needed.
*/
VecCreate(PETSC_COMM_WORLD,&b);
VecSetSizes(b,PETSC_DECIDE,dim);
VecSetFromOptions(b);
// VecDuplicate(b,&x); Assume x is passed in
/*
* Set rhs, b, and solution, x to 1.0 in the first
* element, 0.0 elsewhere.
*/
VecSet(b,0.0);
VecSet(x,0.0);
if(nid==0) {
row = 0;
mat_tmp = 1.0 + 0.0*PETSC_i;
VecSetValue(x,row,mat_tmp,INSERT_VALUES);
VecSetValue(b,row,mat_tmp,INSERT_VALUES);
}
/* Assemble x and b */
VecAssemblyBegin(x);
VecAssemblyEnd(x);
VecAssemblyBegin(b);
VecAssemblyEnd(b);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*
* Create the linear solver and set various options *
*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
* Create linear solver context
*/
KSPCreate(PETSC_COMM_WORLD,&ksp);
/*
* Set operators. Here the matrix that defines the linear system
* also serves as the preconditioning matrix.
*/
KSPSetOperators(ksp,full_A,full_A);
/*
* Set good default options for solver
*/
/* relative tolerance */
KSPSetTolerances(ksp,default_rtol,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);
/* bjacobi preconditioner */
KSPGetPC(ksp,&pc);
PCSetType(pc,PCASM);
/* gmres solver with 100 restart*/
KSPSetType(ksp,KSPGMRES);
KSPGMRESSetRestart(ksp,default_restart);
/*
* Set runtime options, e.g.,
* -ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
*/
KSPSetFromOptions(ksp);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
if (nid==0) printf("KSP set. Solving for steady state...\n");
KSPSolve(ksp,b,x);
num_pop = get_num_populations();
populations = malloc(num_pop*sizeof(double));
get_populations(x,&populations);
if(nid==0){
printf("Final populations: ");
for(i=0;i<num_pop;i++){
printf(" %e ",populations[i]);
}
printf("\n");
}
KSPGetIterationNumber(ksp,&its);
PetscPrintf(PETSC_COMM_WORLD,"Iterations %D\n",its);
/* Free work space */
KSPDestroy(&ksp);
// VecDestroy(&x);
VecDestroy(&b);
return;
}
int main(int argc,char **argv)
{
Mat M,C,K,A[3]; /* problem matrices */
PEP pep; /* polynomial eigenproblem solver context */
PetscInt n=5,Istart,Iend,i;
PetscReal mu=1,tau=10,kappa=5;
PetscBool terse;
PetscErrorCode ierr;
PetscLogDouble time1,time2;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-mu",&mu,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-tau",&tau,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-kappa",&kappa,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nDamped mass-spring system, n=%D mu=%g tau=%g kappa=%g\n\n",n,(double)mu,(double)tau,(double)kappa);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrices that define the eigensystem, (k^2*M+k*C+K)x=0
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* K is a tridiagonal */
ierr = MatCreate(PETSC_COMM_WORLD,&K);CHKERRQ(ierr);
ierr = MatSetSizes(K,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(K);CHKERRQ(ierr);
ierr = MatSetUp(K);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(K,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
if (i>0) {
ierr = MatSetValue(K,i,i-1,-kappa,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatSetValue(K,i,i,kappa*3.0,INSERT_VALUES);CHKERRQ(ierr);
if (i<n-1) {
ierr = MatSetValue(K,i,i+1,-kappa,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(K,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(K,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* C is a tridiagonal */
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
if (i>0) {
ierr = MatSetValue(C,i,i-1,-tau,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatSetValue(C,i,i,tau*3.0,INSERT_VALUES);CHKERRQ(ierr);
if (i<n-1) {
ierr = MatSetValue(C,i,i+1,-tau,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* M is a diagonal matrix */
ierr = MatCreate(PETSC_COMM_WORLD,&M);CHKERRQ(ierr);
ierr = MatSetSizes(M,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(M);CHKERRQ(ierr);
ierr = MatSetUp(M);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(M,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
ierr = MatSetValue(M,i,i,mu,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and solve the problem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PEPCreate(PETSC_COMM_WORLD,&pep);CHKERRQ(ierr);
A[0] = K; A[1] = C; A[2] = M;
ierr = PEPSetOperators(pep,3,A);CHKERRQ(ierr);
ierr = PEPSetFromOptions(pep);CHKERRQ(ierr);
ierr = PetscTime(&time1); CHKERRQ(ierr);
ierr = PEPSolve(pep);CHKERRQ(ierr);
ierr = PetscTime(&time2); CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* show detailed info unless -terse option is given by user */
ierr = PetscOptionsHasName(NULL,"-terse",&terse);CHKERRQ(ierr);
if (terse) {
ierr = PEPErrorView(pep,PEP_ERROR_BACKWARD,NULL);CHKERRQ(ierr);
} else {
ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO_DETAIL);CHKERRQ(ierr);
ierr = PEPReasonView(pep,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PEPErrorView(pep,PEP_ERROR_BACKWARD,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"Time: %g\n\n\n",time2-time1);CHKERRQ(ierr);
ierr = PEPDestroy(&pep);CHKERRQ(ierr);
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&K);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **args)
{
Mat C,A;
PetscInt i,j,m = 3,n = 2,rstart,rend;
PetscMPIInt size,rank;
PetscErrorCode ierr;
PetscScalar v;
IS isrow,iscol;
PetscBool flg;
char type[256];
PetscInitialize(&argc,&args,(char *)0,help);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
n = 2*size;
ierr = PetscStrcpy(type,MATSAME);CHKERRQ(ierr);
ierr = PetscOptionsGetString(PETSC_NULL,"-mat_type",type,256,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscStrcmp(type,MATMPIDENSE,&flg);CHKERRQ(ierr);
if (flg) {
ierr = MatCreateDense(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE, m*n,m*n,PETSC_NULL,&C);CHKERRQ(ierr);
} else {
ierr = MatCreateAIJ(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE, m*n,m*n,PETSC_DECIDE,PETSC_NULL,PETSC_DECIDE,PETSC_NULL,&C);CHKERRQ(ierr);
}
/*
This is JUST to generate a nice test matrix, all processors fill up
the entire matrix. This is not something one would ever do in practice.
*/
for (i=0; i<m*n; i++) {
for (j=0; j<m*n; j++) {
v = i + j + 1;
ierr = MatSetValues(C,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_COMMON);CHKERRQ(ierr);
ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/*
Generate a new matrix consisting of every second row and column of
the original matrix
*/
ierr = MatGetOwnershipRange(C,&rstart,&rend);CHKERRQ(ierr);
/* Create parallel IS with the rows we want on THIS processor */
ierr = ISCreateStride(PETSC_COMM_WORLD,(rend-rstart)/2,rstart,2,&isrow);CHKERRQ(ierr);
/* Create parallel IS with the rows we want on THIS processor (same as rows for now) */
ierr = ISCreateStride(PETSC_COMM_WORLD,(rend-rstart)/2,rstart,2,&iscol);CHKERRQ(ierr);
ierr = MatGetSubMatrix(C,isrow,iscol,MAT_INITIAL_MATRIX,&A);CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatGetSubMatrix(C,isrow,iscol,MAT_REUSE_MATRIX,&A);CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = ISDestroy(&isrow);CHKERRQ(ierr);
ierr = ISDestroy(&iscol);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
//==============================================================================
Epetra_PETScAIJMatrix::Epetra_PETScAIJMatrix(Mat Amat)
: Epetra_Object("Epetra::PETScAIJMatrix"),
Amat_(Amat),
Values_(0),
Indices_(0),
MaxNumEntries_(-1),
ImportVector_(0),
NormInf_(-1.0),
NormOne_(-1.0)
{
#ifdef HAVE_MPI
MPI_Comm comm;
PetscObjectGetComm( (PetscObject)Amat, &comm);
Comm_ = new Epetra_MpiComm(comm);
#else
Comm_ = new Epetra_SerialComm();
#endif
int ierr;
char errMsg[80];
MatGetType(Amat, &MatType_);
if ( strcmp(MatType_,MATSEQAIJ) != 0 && strcmp(MatType_,MATMPIAIJ) != 0 ) {
sprintf(errMsg,"PETSc matrix must be either seqaij or mpiaij (but it is %s)",MatType_);
throw Comm_->ReportError(errMsg,-1);
}
petscMatrixType mt;
Mat_MPIAIJ* aij=0;
if (strcmp(MatType_,MATMPIAIJ) == 0) {
mt = PETSC_MPI_AIJ;
aij = (Mat_MPIAIJ*)Amat->data;
}
else if (strcmp(MatType_,MATSEQAIJ) == 0) {
mt = PETSC_SEQ_AIJ;
}
int numLocalRows, numLocalCols;
ierr = MatGetLocalSize(Amat,&numLocalRows,&numLocalCols);
if (ierr) {
sprintf(errMsg,"EpetraExt_PETScAIJMatrix.cpp, line %d, MatGetLocalSize() returned error code %d",__LINE__,ierr);
throw Comm_->ReportError(errMsg,-1);
}
NumMyRows_ = numLocalRows;
NumMyCols_ = numLocalCols; //numLocalCols is the total # of unique columns in the local matrix (the diagonal block)
//TODO what happens if some columns are empty?
if (mt == PETSC_MPI_AIJ)
NumMyCols_ += aij->B->cmap->n;
MatInfo info;
ierr = MatGetInfo(Amat,MAT_LOCAL,&info);
if (ierr) {
sprintf(errMsg,"EpetraExt_PETScAIJMatrix.cpp, line %d, MatGetInfo() returned error code %d",__LINE__,ierr);
throw Comm_->ReportError(errMsg,-1);
}
NumMyNonzeros_ = (int) info.nz_used; //PETSc stores nnz as double
Comm_->SumAll(&(info.nz_used), &NumGlobalNonzeros_, 1);
//The PETSc documentation warns that this may not be robust.
//In particular, this will break if the ordering is not contiguous!
int rowStart, rowEnd;
ierr = MatGetOwnershipRange(Amat,&rowStart,&rowEnd);
if (ierr) {
sprintf(errMsg,"EpetraExt_PETScAIJMatrix.cpp, line %d, MatGetOwnershipRange() returned error code %d",__LINE__,ierr);
throw Comm_->ReportError(errMsg,-1);
}
PetscRowStart_ = rowStart;
PetscRowEnd_ = rowEnd;
int* MyGlobalElements = new int[rowEnd-rowStart];
for (int i=0; i<rowEnd-rowStart; i++)
MyGlobalElements[i] = rowStart+i;
ierr = MatGetInfo(Amat,MAT_GLOBAL_SUM,&info);
if (ierr) {
sprintf(errMsg,"EpetraExt_PETScAIJMatrix.cpp, line %d, MatGetInfo() returned error code %d",__LINE__,ierr);
throw Comm_->ReportError(errMsg,-1);
}
int tmp;
ierr = MatGetSize(Amat,&NumGlobalRows_,&tmp);
DomainMap_ = new Epetra_Map(NumGlobalRows_, NumMyRows_, MyGlobalElements, 0, *Comm_);
// get the GIDs of the non-local columns
//FIXME what if the matrix is sequential?
int * ColGIDs = new int[NumMyCols_];
for (int i=0; i<numLocalCols; i++) ColGIDs[i] = MyGlobalElements[i];
for (int i=numLocalCols; i<NumMyCols_; i++) ColGIDs[i] = aij->garray[i-numLocalCols];
ColMap_ = new Epetra_Map(-1, NumMyCols_, ColGIDs, 0, *Comm_);
Importer_ = new Epetra_Import(*ColMap_, *DomainMap_);
delete [] MyGlobalElements;
delete [] ColGIDs;
} //Epetra_PETScAIJMatrix(Mat Amat)
int main(int argc,char **argv)
{
Mat A,B,C,D;
PetscInt i,M,N,Istart,Iend,n=7,j,J,Ii,m=8,am,an;
PetscScalar v;
PetscErrorCode ierr;
PetscRandom r;
PetscBool equal=PETSC_FALSE;
PetscReal fill = 1.0;
PetscMPIInt size;
PetscInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,NULL,"-m",&m,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,NULL,"-fill",&fill,NULL);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&r);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(r);CHKERRQ(ierr);
/* Create a aij matrix A */
M = N = m*n;
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
ierr = MatSetType(A,MATAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(A,5,NULL,5,NULL);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(A,5,NULL);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
am = Iend - Istart;
for (Ii=Istart; Ii<Iend; Ii++) {
v = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {J = Ii - n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
if (i<m-1) {J = Ii + n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
if (j>0) {J = Ii - 1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
if (j<n-1) {J = Ii + 1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
v = 4.0; ierr = MatSetValues(A,1,&Ii,1,&Ii,&v,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Create a dense matrix B */
ierr = MatGetLocalSize(A,&am,&an);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&B);CHKERRQ(ierr);
ierr = MatSetSizes(B,an,PETSC_DECIDE,PETSC_DECIDE,M);CHKERRQ(ierr);
ierr = MatSetType(B,MATDENSE);CHKERRQ(ierr);
ierr = MatSeqDenseSetPreallocation(B,NULL);CHKERRQ(ierr);
ierr = MatMPIDenseSetPreallocation(B,NULL);CHKERRQ(ierr);
ierr = MatSetFromOptions(B);CHKERRQ(ierr);
ierr = MatSetRandom(B,r);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&r);CHKERRQ(ierr);
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Test C = A*B (aij*dense) */
ierr = MatMatMult(A,B,MAT_INITIAL_MATRIX,fill,&C);CHKERRQ(ierr);
ierr = MatMatMult(A,B,MAT_REUSE_MATRIX,fill,&C);CHKERRQ(ierr);
ierr = MatMatMultSymbolic(A,B,fill,&D);CHKERRQ(ierr);
for (i=0; i<2; i++) {
ierr = MatMatMultNumeric(A,B,D);CHKERRQ(ierr);
}
ierr = MatEqual(C,D,&equal);CHKERRQ(ierr);
if (!equal) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"C != D");
ierr = MatDestroy(&D);CHKERRQ(ierr);
/* Test D = C*A (dense*aij) */
ierr = MatMatMult(C,A,MAT_INITIAL_MATRIX,fill,&D);CHKERRQ(ierr);
ierr = MatMatMult(C,A,MAT_REUSE_MATRIX,fill,&D);CHKERRQ(ierr);
ierr = MatDestroy(&D);CHKERRQ(ierr);
/* Test D = A*C (aij*dense) */
ierr = MatMatMult(A,C,MAT_INITIAL_MATRIX,fill,&D);CHKERRQ(ierr);
ierr = MatMatMult(A,C,MAT_REUSE_MATRIX,fill,&D);CHKERRQ(ierr);
ierr = MatDestroy(&D);CHKERRQ(ierr);
/* Test D = B*C (dense*dense) */
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size == 1) {
ierr = MatMatMult(B,C,MAT_INITIAL_MATRIX,fill,&D);CHKERRQ(ierr);
ierr = MatMatMult(B,C,MAT_REUSE_MATRIX,fill,&D);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);
}
EXTERN_C_END
EXTERN_C_BEGIN
/*
Simplest coloring, each column of the matrix gets its own unique color.
*/
#undef __FUNCT__
#define __FUNCT__ "MatGetColoring_Natural"
PetscErrorCode MatGetColoring_Natural(Mat mat,MatColoringType color, ISColoring *iscoloring)
{
PetscErrorCode ierr;
PetscInt start,end,i,bs = 1,n;
ISColoringValue *colors;
MPI_Comm comm;
PetscBool flg1,flg2;
Mat mat_seq = mat;
PetscMPIInt size;
ISColoring iscoloring_seq;
ISColoringValue *colors_loc;
PetscInt rstart,rend,N_loc,nc;
PetscFunctionBegin;
/* this is ugly way to get blocksize but cannot call MatGetBlockSize() because AIJ can have bs > 1 */
ierr = PetscObjectTypeCompare((PetscObject)mat,MATSEQBAIJ,&flg1);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)mat,MATMPIBAIJ,&flg2);CHKERRQ(ierr);
if (flg1 || flg2) {
ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
}
ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (size > 1){
/* create a sequential iscoloring on all processors */
ierr = MatGetSeqNonzeroStructure(mat,&mat_seq);CHKERRQ(ierr);
}
ierr = MatGetSize(mat_seq,PETSC_NULL,&n);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(mat_seq,&start,&end);CHKERRQ(ierr);
n = n/bs;
if (n > IS_COLORING_MAX-1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Maximum color size exceeded");
start = start/bs;
end = end/bs;
ierr = PetscMalloc((end-start+1)*sizeof(PetscInt),&colors);CHKERRQ(ierr);
for (i=start; i<end; i++) {
colors[i-start] = (ISColoringValue)i;
}
ierr = ISColoringCreate(comm,n,end-start,colors,iscoloring);CHKERRQ(ierr);
if (size > 1) {
ierr = MatDestroySeqNonzeroStructure(&mat_seq);CHKERRQ(ierr);
/* convert iscoloring_seq to a parallel iscoloring */
iscoloring_seq = *iscoloring;
rstart = mat->rmap->rstart/bs;
rend = mat->rmap->rend/bs;
N_loc = rend - rstart; /* number of local nodes */
/* get local colors for each local node */
ierr = PetscMalloc((N_loc+1)*sizeof(ISColoringValue),&colors_loc);CHKERRQ(ierr);
for (i=rstart; i<rend; i++){
colors_loc[i-rstart] = iscoloring_seq->colors[i];
}
/* create a parallel iscoloring */
nc=iscoloring_seq->n;
ierr = ISColoringCreate(comm,nc,N_loc,colors_loc,iscoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring_seq);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode IPMUpdateAi(Tao tao)
{
/* Ai = Ji
I (w/lb)
-I (w/ub) */
/* Ci = user->ci
Xi - lb (w/lb)
-Xi + ub (w/ub) */
TAO_IPM *ipmP = (TAO_IPM *)tao->data;
MPI_Comm comm;
PetscInt i;
PetscScalar newval;
PetscInt newrow,newcol,ncols;
const PetscScalar *vals;
const PetscInt *cols;
PetscInt astart,aend,jstart,jend;
PetscInt *nonzeros;
PetscInt r2,r3,r4;
PetscMPIInt size;
PetscErrorCode ierr;
PetscFunctionBegin;
r2 = ipmP->mi;
r3 = r2 + ipmP->nxlb;
r4 = r3 + ipmP->nxub;
if (!ipmP->nb) PetscFunctionReturn(0);
/* Create Ai matrix if it doesn't exist yet */
if (!ipmP->Ai) {
comm = ((PetscObject)(tao->solution))->comm;
ierr = PetscMalloc1(ipmP->nb,&nonzeros);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (size == 1) {
for (i=0;i<ipmP->mi;i++) {
ierr = MatGetRow(tao->jacobian_inequality,i,&ncols,NULL,NULL);CHKERRQ(ierr);
nonzeros[i] = ncols;
ierr = MatRestoreRow(tao->jacobian_inequality,i,&ncols,NULL,NULL);CHKERRQ(ierr);
}
for (i=r2;i<r4;i++) {
nonzeros[i] = 1;
}
}
ierr = MatCreate(comm,&ipmP->Ai);CHKERRQ(ierr);
ierr = MatSetType(ipmP->Ai,MATAIJ);CHKERRQ(ierr);
ierr = MatSetSizes(ipmP->Ai,PETSC_DECIDE,PETSC_DECIDE,ipmP->nb,ipmP->n);CHKERRQ(ierr);
ierr = MatSetFromOptions(ipmP->Ai);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(ipmP->Ai,ipmP->nb,NULL,ipmP->nb,NULL);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(ipmP->Ai,PETSC_DEFAULT,nonzeros);CHKERRQ(ierr);
if (size ==1) {
ierr = PetscFree(nonzeros);CHKERRQ(ierr);
}
}
/* Copy values from user jacobian to Ai */
ierr = MatGetOwnershipRange(ipmP->Ai,&astart,&aend);CHKERRQ(ierr);
/* Ai w/lb */
if (ipmP->mi) {
ierr = MatZeroEntries(ipmP->Ai);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(tao->jacobian_inequality,&jstart,&jend);CHKERRQ(ierr);
for (i=jstart;i<jend;i++) {
ierr = MatGetRow(tao->jacobian_inequality,i,&ncols,&cols,&vals);CHKERRQ(ierr);
newrow = i;
ierr = MatSetValues(ipmP->Ai,1,&newrow,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(tao->jacobian_inequality,i,&ncols,&cols,&vals);CHKERRQ(ierr);
}
}
/* I w/ xlb */
if (ipmP->nxlb) {
for (i=0;i<ipmP->nxlb;i++) {
if (i>=astart && i<aend) {
newrow = i+r2;
newcol = i;
newval = 1.0;
ierr = MatSetValues(ipmP->Ai,1,&newrow,1,&newcol,&newval,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
if (ipmP->nxub) {
/* I w/ xub */
for (i=0;i<ipmP->nxub;i++) {
if (i>=astart && i<aend) {
newrow = i+r3;
newcol = i;
newval = -1.0;
ierr = MatSetValues(ipmP->Ai,1,&newrow,1,&newcol,&newval,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
ierr = MatAssemblyBegin(ipmP->Ai,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(ipmP->Ai,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
CHKMEMQ;
ierr = VecSet(ipmP->ci,0.0);CHKERRQ(ierr);
/* user ci */
if (ipmP->mi > 0) {
ierr = VecScatterBegin(ipmP->ci_scat,tao->constraints_inequality,ipmP->ci,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(ipmP->ci_scat,tao->constraints_inequality,ipmP->ci,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
}
if (!ipmP->work){
VecDuplicate(tao->solution,&ipmP->work);
}
ierr = VecCopy(tao->solution,ipmP->work);CHKERRQ(ierr);
if (tao->XL) {
ierr = VecAXPY(ipmP->work,-1.0,tao->XL);CHKERRQ(ierr);
/* lower bounds on variables */
if (ipmP->nxlb > 0) {
ierr = VecScatterBegin(ipmP->xl_scat,ipmP->work,ipmP->ci,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(ipmP->xl_scat,ipmP->work,ipmP->ci,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
}
}
if (tao->XU) {
/* upper bounds on variables */
ierr = VecCopy(tao->solution,ipmP->work);CHKERRQ(ierr);
ierr = VecScale(ipmP->work,-1.0);CHKERRQ(ierr);
ierr = VecAXPY(ipmP->work,1.0,tao->XU);CHKERRQ(ierr);
if (ipmP->nxub > 0) {
ierr = VecScatterBegin(ipmP->xu_scat,ipmP->work,ipmP->ci,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(ipmP->xu_scat,ipmP->work,ipmP->ci,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat C;
Vec u,b;
PetscErrorCode ierr;
PetscMPIInt size,rank;
PetscInt i,m = 5,N,start,end,M,idx[4];
PetscInt j,nrsub,ncsub,*rsub,*csub,mystart,myend;
PetscBool flg;
PetscScalar one = 1.0,Ke[16],*vals;
PetscReal h,norm;
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
ierr = PetscOptionsGetInt(NULL,NULL,"-m",&m,NULL);CHKERRQ(ierr);
N = (m+1)*(m+1); /* dimension of matrix */
M = m*m; /* number of elements */
h = 1.0/m; /* mesh width */
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
/* Create stiffness matrix */
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,N,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
start = rank*(M/size) + ((M%size) < rank ? (M%size) : rank);
end = start + M/size + ((M%size) > rank);
/* Form the element stiffness for the Laplacian */
ierr = FormElementStiffness(h*h,Ke);CHKERRQ(ierr);
for (i=start; i<end; i++) {
/* location of lower left corner of element */
/* node numbers for the four corners of element */
idx[0] = (m+1)*(i/m) + (i % m);
idx[1] = idx[0]+1; idx[2] = idx[1] + m + 1; idx[3] = idx[2] - 1;
ierr = MatSetValues(C,4,idx,4,idx,Ke,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Assemble the matrix again */
ierr = MatZeroEntries(C);CHKERRQ(ierr);
for (i=start; i<end; i++) {
/* location of lower left corner of element */
/* node numbers for the four corners of element */
idx[0] = (m+1)*(i/m) + (i % m);
idx[1] = idx[0]+1; idx[2] = idx[1] + m + 1; idx[3] = idx[2] - 1;
ierr = MatSetValues(C,4,idx,4,idx,Ke,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Create test vectors */
ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr);
ierr = VecSetSizes(u,PETSC_DECIDE,N);CHKERRQ(ierr);
ierr = VecSetFromOptions(u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b);CHKERRQ(ierr);
ierr = VecSet(u,one);CHKERRQ(ierr);
/* Check error */
ierr = MatMult(C,u,b);CHKERRQ(ierr);
ierr = VecNorm(b,NORM_2,&norm);CHKERRQ(ierr);
if (norm > PETSC_SQRT_MACHINE_EPSILON) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error b %g should be near 0\n",(double)norm);CHKERRQ(ierr);
}
/* Now test MatGetValues() */
ierr = PetscOptionsHasName(NULL,NULL,"-get_values",&flg);CHKERRQ(ierr);
if (flg) {
ierr = MatGetOwnershipRange(C,&mystart,&myend);CHKERRQ(ierr);
nrsub = myend - mystart; ncsub = 4;
ierr = PetscMalloc1(nrsub*ncsub,&vals);CHKERRQ(ierr);
ierr = PetscMalloc1(nrsub,&rsub);CHKERRQ(ierr);
ierr = PetscMalloc1(ncsub,&csub);CHKERRQ(ierr);
for (i=myend-1; i>=mystart; i--) rsub[myend-i-1] = i;
for (i=0; i<ncsub; i++) csub[i] = 2*(ncsub-i) + mystart;
ierr = MatGetValues(C,nrsub,rsub,ncsub,csub,vals);CHKERRQ(ierr);
ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"processor number %d: start=%D, end=%D, mystart=%D, myend=%D\n",rank,start,end,mystart,myend);CHKERRQ(ierr);
for (i=0; i<nrsub; i++) {
for (j=0; j<ncsub; j++) {
if (PetscImaginaryPart(vals[i*ncsub+j]) != 0.0) {
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD," C[%D, %D] = %g + %g i\n",rsub[i],csub[j],(double)PetscRealPart(vals[i*ncsub+j]),(double)PetscImaginaryPart(vals[i*ncsub+j]));CHKERRQ(ierr);
} else {
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD," C[%D, %D] = %g\n",rsub[i],csub[j],(double)PetscRealPart(vals[i*ncsub+j]));CHKERRQ(ierr);
}
}
}
ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,PETSC_STDOUT);CHKERRQ(ierr);
ierr = PetscFree(rsub);CHKERRQ(ierr);
ierr = PetscFree(csub);CHKERRQ(ierr);
ierr = PetscFree(vals);CHKERRQ(ierr);
}
/* Free data structures */
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
/* create K = [ Hlag , 0 , Ae', -Ai'];
[Ae , 0, 0 , 0];
[Ai ,-I, 0 , 0];
[ 0 , S , 0, Y ]; */
PetscErrorCode IPMUpdateK(Tao tao)
{
TAO_IPM *ipmP = (TAO_IPM *)tao->data;
MPI_Comm comm;
PetscMPIInt size;
PetscErrorCode ierr;
PetscInt i,j,row;
PetscInt ncols,newcol,newcols[2],newrow;
const PetscInt *cols;
const PetscReal *vals;
const PetscReal *l,*y;
PetscReal *newvals;
PetscReal newval;
PetscInt subsize;
const PetscInt *indices;
PetscInt *nonzeros,*d_nonzeros,*o_nonzeros;
PetscInt bigsize;
PetscInt r1,r2,r3;
PetscInt c1,c2,c3;
PetscInt klocalsize;
PetscInt hstart,hend,kstart,kend;
PetscInt aistart,aiend,aestart,aeend;
PetscInt sstart,send;
PetscFunctionBegin;
comm = ((PetscObject)(tao->solution))->comm;
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = IPMUpdateAi(tao);CHKERRQ(ierr);
/* allocate workspace */
subsize = PetscMax(ipmP->n,ipmP->nb);
subsize = PetscMax(ipmP->me,subsize);
subsize = PetscMax(2,subsize);
ierr = PetscMalloc1(subsize,&indices);CHKERRQ(ierr);
ierr = PetscMalloc1(subsize,&newvals);CHKERRQ(ierr);
r1 = c1 = ipmP->n;
r2 = r1 + ipmP->me; c2 = c1 + ipmP->nb;
r3 = c3 = r2 + ipmP->nb;
bigsize = ipmP->n+2*ipmP->nb+ipmP->me;
ierr = VecGetOwnershipRange(ipmP->bigrhs,&kstart,&kend);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(tao->hessian,&hstart,&hend);CHKERRQ(ierr);
klocalsize = kend-kstart;
if (!ipmP->K) {
if (size == 1) {
ierr = PetscMalloc1(kend-kstart,&nonzeros);CHKERRQ(ierr);
for (i=0;i<bigsize;i++) {
if (i<r1) {
ierr = MatGetRow(tao->hessian,i,&ncols,NULL,NULL);CHKERRQ(ierr);
nonzeros[i] = ncols;
ierr = MatRestoreRow(tao->hessian,i,&ncols,NULL,NULL);CHKERRQ(ierr);
nonzeros[i] += ipmP->me+ipmP->nb;
} else if (i<r2) {
nonzeros[i-kstart] = ipmP->n;
} else if (i<r3) {
nonzeros[i-kstart] = ipmP->n+1;
} else if (i<bigsize) {
nonzeros[i-kstart] = 2;
}
}
ierr = MatCreate(comm,&ipmP->K);CHKERRQ(ierr);
ierr = MatSetType(ipmP->K,MATSEQAIJ);CHKERRQ(ierr);
ierr = MatSetSizes(ipmP->K,klocalsize,klocalsize,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(ipmP->K,0,nonzeros);CHKERRQ(ierr);
ierr = MatSetFromOptions(ipmP->K);CHKERRQ(ierr);
ierr = PetscFree(nonzeros);CHKERRQ(ierr);
} else {
ierr = PetscMalloc1(kend-kstart,&d_nonzeros);CHKERRQ(ierr);
ierr = PetscMalloc1(kend-kstart,&o_nonzeros);CHKERRQ(ierr);
for (i=kstart;i<kend;i++) {
if (i<r1) {
/* TODO fix preallocation for mpi mats */
d_nonzeros[i-kstart] = PetscMin(ipmP->n+ipmP->me+ipmP->nb,kend-kstart);
o_nonzeros[i-kstart] = PetscMin(ipmP->n+ipmP->me+ipmP->nb,bigsize-(kend-kstart));
} else if (i<r2) {
d_nonzeros[i-kstart] = PetscMin(ipmP->n,kend-kstart);
o_nonzeros[i-kstart] = PetscMin(ipmP->n,bigsize-(kend-kstart));
} else if (i<r3) {
d_nonzeros[i-kstart] = PetscMin(ipmP->n+2,kend-kstart);
o_nonzeros[i-kstart] = PetscMin(ipmP->n+2,bigsize-(kend-kstart));
} else {
d_nonzeros[i-kstart] = PetscMin(2,kend-kstart);
o_nonzeros[i-kstart] = PetscMin(2,bigsize-(kend-kstart));
}
}
ierr = MatCreate(comm,&ipmP->K);CHKERRQ(ierr);
ierr = MatSetType(ipmP->K,MATMPIAIJ);CHKERRQ(ierr);
ierr = MatSetSizes(ipmP->K,klocalsize,klocalsize,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(ipmP->K,0,d_nonzeros,0,o_nonzeros);CHKERRQ(ierr);
ierr = PetscFree(d_nonzeros);CHKERRQ(ierr);
ierr = PetscFree(o_nonzeros);CHKERRQ(ierr);
ierr = MatSetFromOptions(ipmP->K);CHKERRQ(ierr);
}
}
ierr = MatZeroEntries(ipmP->K);CHKERRQ(ierr);
/* Copy H */
for (i=hstart;i<hend;i++) {
ierr = MatGetRow(tao->hessian,i,&ncols,&cols,&vals);CHKERRQ(ierr);
if (ncols > 0) {
ierr = MatSetValues(ipmP->K,1,&i,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatRestoreRow(tao->hessian,i,&ncols,&cols,&vals);CHKERRQ(ierr);
}
/* Copy Ae and Ae' */
if (ipmP->me > 0) {
ierr = MatGetOwnershipRange(tao->jacobian_equality,&aestart,&aeend);CHKERRQ(ierr);
for (i=aestart;i<aeend;i++) {
ierr = MatGetRow(tao->jacobian_equality,i,&ncols,&cols,&vals);CHKERRQ(ierr);
if (ncols > 0) {
/*Ae*/
row = i+r1;
ierr = MatSetValues(ipmP->K,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
/*Ae'*/
for (j=0;j<ncols;j++) {
newcol = i + c2;
newrow = cols[j];
newval = vals[j];
ierr = MatSetValues(ipmP->K,1,&newrow,1,&newcol,&newval,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatRestoreRow(tao->jacobian_equality,i,&ncols,&cols,&vals);CHKERRQ(ierr);
}
}
if (ipmP->nb > 0) {
ierr = MatGetOwnershipRange(ipmP->Ai,&aistart,&aiend);CHKERRQ(ierr);
/* Copy Ai,and Ai' */
for (i=aistart;i<aiend;i++) {
row = i+r2;
ierr = MatGetRow(ipmP->Ai,i,&ncols,&cols,&vals);CHKERRQ(ierr);
if (ncols > 0) {
/*Ai*/
ierr = MatSetValues(ipmP->K,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
/*-Ai'*/
for (j=0;j<ncols;j++) {
newcol = i + c3;
newrow = cols[j];
newval = -vals[j];
ierr = MatSetValues(ipmP->K,1,&newrow,1,&newcol,&newval,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatRestoreRow(ipmP->Ai,i,&ncols,&cols,&vals);CHKERRQ(ierr);
}
/* -I */
for (i=kstart;i<kend;i++) {
if (i>=r2 && i<r3) {
newrow = i;
newcol = i-r2+c1;
newval = -1.0;
MatSetValues(ipmP->K,1,&newrow,1,&newcol,&newval,INSERT_VALUES);CHKERRQ(ierr);
}
}
/* Copy L,Y */
ierr = VecGetOwnershipRange(ipmP->s,&sstart,&send);CHKERRQ(ierr);
ierr = VecGetArrayRead(ipmP->lamdai,&l);CHKERRQ(ierr);
ierr = VecGetArrayRead(ipmP->s,&y);CHKERRQ(ierr);
for (i=sstart;i<send;i++) {
newcols[0] = c1+i;
newcols[1] = c3+i;
newvals[0] = l[i-sstart];
newvals[1] = y[i-sstart];
newrow = r3+i;
ierr = MatSetValues(ipmP->K,1,&newrow,2,newcols,newvals,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecRestoreArrayRead(ipmP->lamdai,&l);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(ipmP->s,&y);CHKERRQ(ierr);
}
ierr = PetscFree(indices);CHKERRQ(ierr);
ierr = PetscFree(newvals);CHKERRQ(ierr);
ierr = MatAssemblyBegin(ipmP->K,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(ipmP->K,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void
cljp_coarsening(Mat depends_on, IS *pCoarse) {
const int debug = 0;
//create a vector of the weights.
Vec w;
MatGetVecs(depends_on, PETSC_NULL, &w);
VecZeroEntries(w);
//Get my local matrix size
PetscInt start;
PetscInt end;
MatGetOwnershipRange(depends_on, &start, &end);
//TODO: replace with something that doesn't require re-creating the matrix structure.
//Initialize all the weights
{
Mat influences;
MatTranspose(depends_on, &influences);
{
RawGraph influences_raw(influences);
assert(influences_raw.local_nrows() == end-start);
//Initialize the weight vector with \norm{S^T_i} + \sigma(i)
PetscScalar *local_weights;
VecGetArray(w, &local_weights);
for (int local_row=0; local_row < influences_raw.local_nrows(); local_row++) {
local_weights[local_row] =
influences_raw.ia(local_row+1)-influences_raw.ia(local_row) + frand();
}
VecRestoreArray(w, &local_weights);
}
MatDestroy(influences);
}
//VecView(w, PETSC_VIEWER_STDOUT_WORLD);
//--------------------------------------------------------------
//Prepare the scatters needed for the independent set algorithm.
IS all_local_nodes;
describe_partition(depends_on, &all_local_nodes);
NonlocalCollection nonlocal(depends_on, all_local_nodes);
ISDestroy(all_local_nodes);
//while we are here, get the matrix + graph nodes that we need.
Mat extended_depend_mat;
get_matrix_rows(depends_on, nonlocal.nodes, &extended_depend_mat);
// Vec used only for display purposes
enum NodeType {UNKNOWN=-1, FINE, COARSE};
Vec node_type;
VecDuplicate(w, &node_type);
VecSet(node_type, UNKNOWN);
Vec w_nonlocal;
VecDuplicate(nonlocal.vec, &w_nonlocal);
Vec node_type_nonlocal;
VecDuplicate(w_nonlocal, &node_type_nonlocal);
VecSet(node_type_nonlocal, UNKNOWN);
Vec is_not_independent;
VecDuplicate(w, &is_not_independent);
Vec is_not_independent_nonlocal;
VecDuplicate(w_nonlocal, &is_not_independent_nonlocal);
VecScatterBegin(nonlocal.scatter, w, w_nonlocal, INSERT_VALUES, SCATTER_FORWARD);
VecScatterEnd(nonlocal.scatter, w, w_nonlocal, INSERT_VALUES, SCATTER_FORWARD);
Vec w_update_nonlocal;
VecDuplicate(w_nonlocal, &w_update_nonlocal);
//get ready to find all the coarse and fine points
typedef std::set<PetscInt> IntSet;
IntSet unknown;
//initialize the unknown set with all points that are local to this processor.
for (int ii=start; ii<end; ii++) {
unknown.insert(ii);
}
//we use MPI_INT here because we need to allreduce it with MPI_LAND
int all_points_partitioned=0;
int inc = 0;
{
RawGraph dep_nonlocal_raw(extended_depend_mat);
//while not done
while(!all_points_partitioned) {
//Start: non-local weights, non-local coarse points
if (debug) {
LTRACE();
char fname[] = "weightsXXX";
char selection_graph[] = "selectionXXX";
sprintf(fname, "weights%03d", inc);
sprintf(selection_graph, "selection%03d", inc);
inc++;
/*
PetscViewer view;
PetscViewerBinaryMatlabOpen(PETSC_COMM_WORLD, fname, &view);
PetscViewerBinaryMatlabOutputVecDA(view, "z", w, user->da);
PetscViewerBinaryMatlabDestroy(view);
PetscViewerBinaryMatlabOpen(PETSC_COMM_WORLD, selection_graph, &view);
PetscViewerBinaryMatlabOutputVecDA(view, "z", node_type, user->da);
PetscViewerBinaryMatlabDestroy(view);
//*/
}
//Pre: non-local weights, non-local coarse points
//find the independent set.
//By using ADD_VALUES in a scattter, we can perform
//a boolean OR across procesors.
//is_not_independent[*] = false
VecSet(is_not_independent_nonlocal, 0);
//for all unknown points P
{
RawVector node_type_nonlocal_raw(node_type_nonlocal);
RawVector w_nonlocal_raw(w_nonlocal);
RawVector is_not_independent_nonlocal_raw(is_not_independent_nonlocal);
FOREACH(P, unknown) {
//get weight(P)
PetscScalar weight_P = w_nonlocal_raw.at(nonlocal.map[*P]);
//for all dependencies K of P (K st P->K)
for (PetscInt ii=0; ii<dep_nonlocal_raw.nnz_in_row(nonlocal.map[*P]); ii++) {
PetscInt K = dep_nonlocal_raw.col(nonlocal.map[*P], ii);
//skip if K is fine/coarse
/*
Notice that we don't have to consider the
independent set we've been generating here. By
construction, if K is in the independent set, then P
cannot be in the independent set.
*/
if (node_type_nonlocal_raw.at(nonlocal.map[K]) != UNKNOWN) {
continue;
}
//skip if P->K is marked
if (dep_nonlocal_raw.is_marked(nonlocal.map[*P], ii)) {
continue;
}
//get weight(K)
PetscScalar weight_K = w_nonlocal_raw.at(nonlocal.map[K]);
if (weight_K <= weight_P) {
//is_not_independent(K) = true
is_not_independent_nonlocal_raw.at(nonlocal.map[K]) = 1;
} else { // (weight(P) < weight_K)
is_not_independent_nonlocal_raw.at(nonlocal.map[*P]) = 1;
}
}
}
}
if (debug) {LTRACE();}
//VecView(is_not_independent_nonlocal, PETSC_VIEWER_STDOUT_WORLD);
//reconstruct is_not_independent vector with a ADD_VALUES, which
//performs boolean OR
VecSet(is_not_independent, 0);
VecScatterBegin(nonlocal.scatter, is_not_independent_nonlocal, is_not_independent, ADD_VALUES, SCATTER_REVERSE);
VecScatterEnd(nonlocal.scatter, is_not_independent_nonlocal, is_not_independent, ADD_VALUES, SCATTER_REVERSE);
IntSet new_coarse_points;
{
RawVector is_not_independent_raw(is_not_independent);
//for all unknown points P
FOREACH(P, unknown) {
//if (!is_not_independent(P))
if (is_not_independent_raw.at(*P) == 0) {
new_coarse_points.insert(*P);
if (debug) {SHOWVAR(*P, d);}
}
}
}
//Post: new coarse points (independent set)
if (debug) {LTRACE();}
//Pre: independent set
{
RawVector node_type_raw(node_type);
// for each independent point
FOREACH(I, new_coarse_points) {
//mark that point as coarse
node_type_raw.at(*I) = COARSE;
unknown.erase(*I);
}
}
//Post: updated coarse local
if (debug) {LTRACE();}
//Pre: updated coarse local
//scatter changes to other processors
VecScatterBegin(nonlocal.scatter, node_type, node_type_nonlocal, INSERT_VALUES, SCATTER_FORWARD);
VecScatterEnd(nonlocal.scatter, node_type, node_type_nonlocal, INSERT_VALUES, SCATTER_FORWARD);
//Post: updated coarse non-local
if (debug) {LTRACE();}
//Pre: updated coarse non-local, new local coarse points
VecSet(w_update_nonlocal, 0);
{
RawVector node_type_nonlocal_raw(node_type_nonlocal);
RawVector w_update_nonlocal_raw(w_update_nonlocal);
//for all new coarse points C
FOREACH(C, new_coarse_points) {
//for all K st C->K
for(PetscInt ii=0; ii<dep_nonlocal_raw.nnz_in_row(nonlocal.map[*C]); ii++) {
//mark (C->K)
dep_nonlocal_raw.mark(nonlocal.map[*C], ii);
PetscInt K = dep_nonlocal_raw.col(nonlocal.map[*C], ii);
//if K is unknown
if (node_type_nonlocal_raw.at(nonlocal.map[K]) == UNKNOWN) {
//measure(K)--
w_update_nonlocal_raw.at(nonlocal.map[K]) -= 1;
}
}
}
//for all unknown points I
FOREACH(I, unknown) {
IntSet common_coarse;
//for all (J->K)
for (PetscInt kk=0; kk<dep_nonlocal_raw.nnz_in_row(nonlocal.map[*I]); kk++) {
if (!dep_nonlocal_raw.is_marked(nonlocal.map[*I], kk)) {
//if K is coarse
PetscInt K = dep_nonlocal_raw.col(nonlocal.map[*I], kk);
if (node_type_nonlocal_raw.at(nonlocal.map[K]) == COARSE) {
//mark K as common coarse
common_coarse.insert(K);
//mark (J->K) if unmarked
dep_nonlocal_raw.mark(nonlocal.map[*I], kk);
}
}
}
//for all unmarked (I->J)
for (PetscInt jj=0; jj<dep_nonlocal_raw.nnz_in_row(nonlocal.map[*I]); jj++) {
if (!dep_nonlocal_raw.is_marked(nonlocal.map[*I], jj)) {
//for all (J->K), marked or no
PetscInt J = dep_nonlocal_raw.col(nonlocal.map[*I], jj);
for(PetscInt kk=0; kk<dep_nonlocal_raw.nnz_in_row(nonlocal.map[J]); kk++) {
//if K is in layer or ghost layer and common-coarse
PetscInt K = dep_nonlocal_raw.col(nonlocal.map[J], kk);
if (is_member(K, common_coarse)) {
//mark (I->J)
dep_nonlocal_raw.mark(nonlocal.map[*I], jj);
//measure(J)--
w_update_nonlocal_raw.at(nonlocal.map[J]) -= 1;
}
}
}
}
}
}
PetscErrorCode maxIndSetAgg(IS perm,Mat Gmat,PetscBool strict_aggs,PetscCoarsenData **a_locals_llist)
{
PetscErrorCode ierr;
Mat_SeqAIJ *matA,*matB=NULL;
Mat_MPIAIJ *mpimat=NULL;
MPI_Comm comm;
PetscInt num_fine_ghosts,kk,n,ix,j,*idx,*ii,iter,Iend,my0,nremoved,gid,lid,cpid,lidj,sgid,t1,t2,slid,nDone,nselected=0,state,statej;
PetscInt *cpcol_gid,*cpcol_state,*lid_cprowID,*lid_gid,*cpcol_sel_gid,*icpcol_gid,*lid_state,*lid_parent_gid=NULL;
PetscBool *lid_removed;
PetscBool isMPI,isAIJ,isOK;
const PetscInt *perm_ix;
const PetscInt nloc = Gmat->rmap->n;
PetscCoarsenData *agg_lists;
PetscLayout layout;
PetscSF sf;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)Gmat,&comm);
CHKERRQ(ierr);
/* get submatrices */
ierr = PetscObjectTypeCompare((PetscObject)Gmat,MATMPIAIJ,&isMPI);
CHKERRQ(ierr);
if (isMPI) {
mpimat = (Mat_MPIAIJ*)Gmat->data;
matA = (Mat_SeqAIJ*)mpimat->A->data;
matB = (Mat_SeqAIJ*)mpimat->B->data;
/* force compressed storage of B */
ierr = MatCheckCompressedRow(mpimat->B,matB->nonzerorowcnt,&matB->compressedrow,matB->i,Gmat->rmap->n,-1.0);
CHKERRQ(ierr);
} else {
ierr = PetscObjectTypeCompare((PetscObject)Gmat,MATSEQAIJ,&isAIJ);
CHKERRQ(ierr);
matA = (Mat_SeqAIJ*)Gmat->data;
}
ierr = MatGetOwnershipRange(Gmat,&my0,&Iend);
CHKERRQ(ierr);
ierr = PetscMalloc1(nloc,&lid_gid);
CHKERRQ(ierr); /* explicit array needed */
if (mpimat) {
for (kk=0,gid=my0; kk<nloc; kk++,gid++) {
lid_gid[kk] = gid;
}
ierr = VecGetLocalSize(mpimat->lvec, &num_fine_ghosts);
CHKERRQ(ierr);
ierr = PetscMalloc1(num_fine_ghosts,&cpcol_gid);
CHKERRQ(ierr);
ierr = PetscMalloc1(num_fine_ghosts,&cpcol_state);
CHKERRQ(ierr);
ierr = PetscSFCreate(PetscObjectComm((PetscObject)Gmat),&sf);
CHKERRQ(ierr);
ierr = MatGetLayouts(Gmat,&layout,NULL);
CHKERRQ(ierr);
ierr = PetscSFSetGraphLayout(sf,layout,num_fine_ghosts,NULL,PETSC_COPY_VALUES,mpimat->garray);
CHKERRQ(ierr);
ierr = PetscSFBcastBegin(sf,MPIU_INT,lid_gid,cpcol_gid);
CHKERRQ(ierr);
ierr = PetscSFBcastEnd(sf,MPIU_INT,lid_gid,cpcol_gid);
CHKERRQ(ierr);
for (kk=0; kk<num_fine_ghosts; kk++) {
cpcol_state[kk]=MIS_NOT_DONE;
}
} else num_fine_ghosts = 0;
ierr = PetscMalloc1(nloc, &lid_cprowID);
CHKERRQ(ierr);
ierr = PetscMalloc1(nloc, &lid_removed);
CHKERRQ(ierr); /* explicit array needed */
if (strict_aggs) {
ierr = PetscMalloc1(nloc,&lid_parent_gid);
CHKERRQ(ierr);
}
ierr = PetscMalloc1(nloc,&lid_state);
CHKERRQ(ierr);
/* has ghost nodes for !strict and uses local indexing (yuck) */
ierr = PetscCDCreate(strict_aggs ? nloc : num_fine_ghosts+nloc, &agg_lists);
CHKERRQ(ierr);
if (a_locals_llist) *a_locals_llist = agg_lists;
/* need an inverse map - locals */
for (kk=0; kk<nloc; kk++) {
lid_cprowID[kk] = -1;
lid_removed[kk] = PETSC_FALSE;
if (strict_aggs) {
lid_parent_gid[kk] = -1.0;
}
lid_state[kk] = MIS_NOT_DONE;
}
/* set index into cmpressed row 'lid_cprowID' */
if (matB) {
for (ix=0; ix<matB->compressedrow.nrows; ix++) {
lid = matB->compressedrow.rindex[ix];
lid_cprowID[lid] = ix;
}
}
/* MIS */
iter = nremoved = nDone = 0;
ierr = ISGetIndices(perm, &perm_ix);
CHKERRQ(ierr);
while (nDone < nloc || PETSC_TRUE) { /* asyncronous not implemented */
iter++;
/* check all vertices */
for (kk=0; kk<nloc; kk++) {
lid = perm_ix[kk];
state = lid_state[lid];
if (lid_removed[lid]) continue;
if (state == MIS_NOT_DONE) {
/* parallel test, delete if selected ghost */
isOK = PETSC_TRUE;
if ((ix=lid_cprowID[lid]) != -1) { /* if I have any ghost neighbors */
ii = matB->compressedrow.i;
n = ii[ix+1] - ii[ix];
idx = matB->j + ii[ix];
for (j=0; j<n; j++) {
cpid = idx[j]; /* compressed row ID in B mat */
gid = cpcol_gid[cpid];
statej = cpcol_state[cpid];
if (statej == MIS_NOT_DONE && gid >= Iend) { /* should be (pe>rank), use gid as pe proxy */
isOK = PETSC_FALSE; /* can not delete */
break;
}
}
} /* parallel test */
if (isOK) { /* select or remove this vertex */
nDone++;
/* check for singleton */
ii = matA->i;
n = ii[lid+1] - ii[lid];
if (n < 2) {
/* if I have any ghost adj then not a sing */
ix = lid_cprowID[lid];
if (ix==-1 || (matB->compressedrow.i[ix+1]-matB->compressedrow.i[ix])==0) {
nremoved++;
lid_removed[lid] = PETSC_TRUE;
/* should select this because it is technically in the MIS but lets not */
continue; /* one local adj (me) and no ghost - singleton */
}
}
/* SELECTED state encoded with global index */
lid_state[lid] = lid+my0; /* needed???? */
nselected++;
if (strict_aggs) {
ierr = PetscCDAppendID(agg_lists, lid, lid+my0);
CHKERRQ(ierr);
} else {
ierr = PetscCDAppendID(agg_lists, lid, lid);
CHKERRQ(ierr);
}
/* delete local adj */
idx = matA->j + ii[lid];
for (j=0; j<n; j++) {
lidj = idx[j];
statej = lid_state[lidj];
if (statej == MIS_NOT_DONE) {
nDone++;
if (strict_aggs) {
ierr = PetscCDAppendID(agg_lists, lid, lidj+my0);
CHKERRQ(ierr);
} else {
ierr = PetscCDAppendID(agg_lists, lid, lidj);
CHKERRQ(ierr);
}
lid_state[lidj] = MIS_DELETED; /* delete this */
}
}
/* delete ghost adj of lid - deleted ghost done later for strict_aggs */
if (!strict_aggs) {
if ((ix=lid_cprowID[lid]) != -1) { /* if I have any ghost neighbors */
ii = matB->compressedrow.i;
n = ii[ix+1] - ii[ix];
idx = matB->j + ii[ix];
for (j=0; j<n; j++) {
cpid = idx[j]; /* compressed row ID in B mat */
statej = cpcol_state[cpid];
if (statej == MIS_NOT_DONE) {
ierr = PetscCDAppendID(agg_lists, lid, nloc+cpid);
CHKERRQ(ierr);
}
}
}
}
} /* selected */
} /* not done vertex */
} /* vertex loop */
/* update ghost states and count todos */
if (mpimat) {
/* scatter states, check for done */
ierr = PetscSFBcastBegin(sf,MPIU_INT,lid_state,cpcol_state);
CHKERRQ(ierr);
ierr = PetscSFBcastEnd(sf,MPIU_INT,lid_state,cpcol_state);
CHKERRQ(ierr);
ii = matB->compressedrow.i;
for (ix=0; ix<matB->compressedrow.nrows; ix++) {
lid = matB->compressedrow.rindex[ix]; /* local boundary node */
state = lid_state[lid];
if (state == MIS_NOT_DONE) {
/* look at ghosts */
n = ii[ix+1] - ii[ix];
idx = matB->j + ii[ix];
for (j=0; j<n; j++) {
cpid = idx[j]; /* compressed row ID in B mat */
statej = cpcol_state[cpid];
if (MIS_IS_SELECTED(statej)) { /* lid is now deleted, do it */
nDone++;
lid_state[lid] = MIS_DELETED; /* delete this */
if (!strict_aggs) {
lidj = nloc + cpid;
ierr = PetscCDAppendID(agg_lists, lidj, lid);
CHKERRQ(ierr);
} else {
sgid = cpcol_gid[cpid];
lid_parent_gid[lid] = sgid; /* keep track of proc that I belong to */
}
break;
}
}
}
}
/* all done? */
t1 = nloc - nDone;
ierr = MPI_Allreduce(&t1, &t2, 1, MPIU_INT, MPI_SUM, comm);
CHKERRQ(ierr); /* synchronous version */
if (t2 == 0) break;
} else break; /* all done */
} /* outer parallel MIS loop */
ierr = ISRestoreIndices(perm,&perm_ix);
CHKERRQ(ierr);
ierr = PetscInfo3(Gmat,"\t removed %D of %D vertices. %D selected.\n",nremoved,nloc,nselected);
CHKERRQ(ierr);
/* tell adj who my lid_parent_gid vertices belong to - fill in agg_lists selected ghost lists */
if (strict_aggs && matB) {
/* need to copy this to free buffer -- should do this globaly */
ierr = PetscMalloc1(num_fine_ghosts, &cpcol_sel_gid);
CHKERRQ(ierr);
ierr = PetscMalloc1(num_fine_ghosts, &icpcol_gid);
CHKERRQ(ierr);
for (cpid=0; cpid<num_fine_ghosts; cpid++) icpcol_gid[cpid] = cpcol_gid[cpid];
/* get proc of deleted ghost */
ierr = PetscSFBcastBegin(sf,MPIU_INT,lid_parent_gid,cpcol_sel_gid);
CHKERRQ(ierr);
ierr = PetscSFBcastEnd(sf,MPIU_INT,lid_parent_gid,cpcol_sel_gid);
CHKERRQ(ierr);
for (cpid=0; cpid<num_fine_ghosts; cpid++) {
sgid = cpcol_sel_gid[cpid];
gid = icpcol_gid[cpid];
if (sgid >= my0 && sgid < Iend) { /* I own this deleted */
slid = sgid - my0;
ierr = PetscCDAppendID(agg_lists, slid, gid);
CHKERRQ(ierr);
}
}
ierr = PetscFree(icpcol_gid);
CHKERRQ(ierr);
ierr = PetscFree(cpcol_sel_gid);
CHKERRQ(ierr);
}
if (mpimat) {
ierr = PetscSFDestroy(&sf);
CHKERRQ(ierr);
ierr = PetscFree(cpcol_gid);
CHKERRQ(ierr);
ierr = PetscFree(cpcol_state);
CHKERRQ(ierr);
}
ierr = PetscFree(lid_cprowID);
CHKERRQ(ierr);
ierr = PetscFree(lid_gid);
CHKERRQ(ierr);
ierr = PetscFree(lid_removed);
CHKERRQ(ierr);
if (strict_aggs) {
ierr = PetscFree(lid_parent_gid);
CHKERRQ(ierr);
}
ierr = PetscFree(lid_state);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
Mat A[NMAT]; /* problem matrices */
PEP pep; /* polynomial eigenproblem solver context */
PetscInt n,m=8,k,II,Istart,Iend,i,j;
PetscReal c[10] = { 0.6, 1.3, 1.3, 0.1, 0.1, 1.2, 1.0, 1.0, 1.2, 1.0 };
PetscBool flg;
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-m",&m,NULL);CHKERRQ(ierr);
n = m*m;
k = 10;
ierr = PetscOptionsGetRealArray(NULL,"-c",c,&k,&flg);CHKERRQ(ierr);
if (flg && k!=10) SETERRQ1(PETSC_COMM_WORLD,1,"The number of parameters -c should be 10, you provided %D",k);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nButterfly problem, n=%D (m=%D)\n\n",n,m);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the polynomial matrices
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* initialize matrices */
for (i=0;i<NMAT;i++) {
ierr = MatCreate(PETSC_COMM_WORLD,&A[i]);CHKERRQ(ierr);
ierr = MatSetSizes(A[i],PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A[i]);CHKERRQ(ierr);
ierr = MatSetUp(A[i]);CHKERRQ(ierr);
}
ierr = MatGetOwnershipRange(A[0],&Istart,&Iend);CHKERRQ(ierr);
/* A0 */
for (II=Istart;II<Iend;II++) {
i = II/m; j = II-i*m;
ierr = MatSetValue(A[0],II,II,4.0*c[0]/6.0+4.0*c[1]/6.0,INSERT_VALUES);CHKERRQ(ierr);
if (j>0) { ierr = MatSetValue(A[0],II,II-1,c[0]/6.0,INSERT_VALUES);CHKERRQ(ierr); }
if (j<m-1) { ierr = MatSetValue(A[0],II,II+1,c[0]/6.0,INSERT_VALUES);CHKERRQ(ierr); }
if (i>0) { ierr = MatSetValue(A[0],II,II-m,c[1]/6.0,INSERT_VALUES);CHKERRQ(ierr); }
if (i<m-1) { ierr = MatSetValue(A[0],II,II+m,c[1]/6.0,INSERT_VALUES);CHKERRQ(ierr); }
}
/* A1 */
for (II=Istart;II<Iend;II++) {
i = II/m; j = II-i*m;
if (j>0) { ierr = MatSetValue(A[1],II,II-1,c[2],INSERT_VALUES);CHKERRQ(ierr); }
if (j<m-1) { ierr = MatSetValue(A[1],II,II+1,-c[2],INSERT_VALUES);CHKERRQ(ierr); }
if (i>0) { ierr = MatSetValue(A[1],II,II-m,c[3],INSERT_VALUES);CHKERRQ(ierr); }
if (i<m-1) { ierr = MatSetValue(A[1],II,II+m,-c[3],INSERT_VALUES);CHKERRQ(ierr); }
}
/* A2 */
for (II=Istart;II<Iend;II++) {
i = II/m; j = II-i*m;
ierr = MatSetValue(A[2],II,II,-2.0*c[4]-2.0*c[5],INSERT_VALUES);CHKERRQ(ierr);
if (j>0) { ierr = MatSetValue(A[2],II,II-1,c[4],INSERT_VALUES);CHKERRQ(ierr); }
if (j<m-1) { ierr = MatSetValue(A[2],II,II+1,c[4],INSERT_VALUES);CHKERRQ(ierr); }
if (i>0) { ierr = MatSetValue(A[2],II,II-m,c[5],INSERT_VALUES);CHKERRQ(ierr); }
if (i<m-1) { ierr = MatSetValue(A[2],II,II+m,c[5],INSERT_VALUES);CHKERRQ(ierr); }
}
/* A3 */
for (II=Istart;II<Iend;II++) {
i = II/m; j = II-i*m;
if (j>0) { ierr = MatSetValue(A[3],II,II-1,c[6],INSERT_VALUES);CHKERRQ(ierr); }
if (j<m-1) { ierr = MatSetValue(A[3],II,II+1,-c[6],INSERT_VALUES);CHKERRQ(ierr); }
if (i>0) { ierr = MatSetValue(A[3],II,II-m,c[7],INSERT_VALUES);CHKERRQ(ierr); }
if (i<m-1) { ierr = MatSetValue(A[3],II,II+m,-c[7],INSERT_VALUES);CHKERRQ(ierr); }
}
/* A4 */
for (II=Istart;II<Iend;II++) {
i = II/m; j = II-i*m;
ierr = MatSetValue(A[4],II,II,2.0*c[8]+2.0*c[9],INSERT_VALUES);CHKERRQ(ierr);
if (j>0) { ierr = MatSetValue(A[4],II,II-1,-c[8],INSERT_VALUES);CHKERRQ(ierr); }
if (j<m-1) { ierr = MatSetValue(A[4],II,II+1,-c[8],INSERT_VALUES);CHKERRQ(ierr); }
if (i>0) { ierr = MatSetValue(A[4],II,II-m,-c[9],INSERT_VALUES);CHKERRQ(ierr); }
if (i<m-1) { ierr = MatSetValue(A[4],II,II+m,-c[9],INSERT_VALUES);CHKERRQ(ierr); }
}
/* assemble matrices */
for (i=0;i<NMAT;i++) {
ierr = MatAssemblyBegin(A[i],MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
for (i=0;i<NMAT;i++) {
ierr = MatAssemblyEnd(A[i],MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and solve the problem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PEPCreate(PETSC_COMM_WORLD,&pep);CHKERRQ(ierr);
ierr = PEPSetOperators(pep,NMAT,A);CHKERRQ(ierr);
ierr = PEPSetFromOptions(pep);CHKERRQ(ierr);
ierr = PEPSolve(pep);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PEPPrintSolution(pep,NULL);CHKERRQ(ierr);
ierr = PEPDestroy(&pep);CHKERRQ(ierr);
for (i=0;i<NMAT;i++) {
ierr = MatDestroy(&A[i]);CHKERRQ(ierr);
}
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **args)
{
Mat A,B,F;
PetscErrorCode ierr;
KSP ksp;
PC pc;
PetscInt N, n=10, m, Istart, Iend, II, J, i,j;
PetscInt nneg, nzero, npos;
PetscScalar v,sigma;
PetscBool flag,loadA=PETSC_FALSE,loadB=PETSC_FALSE;
char file[2][PETSC_MAX_PATH_LEN];
PetscViewer viewer;
PetscMPIInt rank;
PetscInitialize(&argc,&args,(char *)0,help);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrices that define the eigensystem, Ax=kBx
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscOptionsGetString(PETSC_NULL,"-fA",file[0],PETSC_MAX_PATH_LEN,&loadA);CHKERRQ(ierr);
if (loadA) {
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[0],FILE_MODE_READ,&viewer);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetType(A,MATSBAIJ);CHKERRQ(ierr);
ierr = MatLoad(A,viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = PetscOptionsGetString(PETSC_NULL,"-fB",file[1],PETSC_MAX_PATH_LEN,&loadB);CHKERRQ(ierr);
if (loadB){
/* load B to get A = A + sigma*B */
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[1],FILE_MODE_READ,&viewer);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&B);CHKERRQ(ierr);
ierr = MatSetType(B,MATSBAIJ);CHKERRQ(ierr);
ierr = MatLoad(B,viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
}
if (!loadA) { /* Matrix A is copied from slepc-3.0.0-p6/src/examples/ex13.c. */
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,&flag);CHKERRQ(ierr);
if( flag==PETSC_FALSE ) m=n;
N = n*m;
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,N,N);CHKERRQ(ierr);
ierr = MatSetType(A,MATSBAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatSetOption(A,MAT_IGNORE_LOWER_TRIANGULAR,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
for( II=Istart; II<Iend; II++ ) {
v = -1.0; i = II/n; j = II-i*n;
if(i>0) { J=II-n; MatSetValues(A,1,&II,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); }
if(i<m-1) { J=II+n; MatSetValues(A,1,&II,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); }
if(j>0) { J=II-1; MatSetValues(A,1,&II,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); }
if(j<n-1) { J=II+1; MatSetValues(A,1,&II,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); }
v=4.0; MatSetValues(A,1,&II,1,&II,&v,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
/* ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); */
if (!loadB) {
ierr = MatGetLocalSize(A,&m,&n);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&B);CHKERRQ(ierr);
ierr = MatSetSizes(B,m,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
ierr = MatSetType(B,MATSBAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(B);CHKERRQ(ierr);
ierr = MatSetUp(B);CHKERRQ(ierr);
ierr = MatSetOption(B,MAT_IGNORE_LOWER_TRIANGULAR,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
for( II=Istart; II<Iend; II++ ) {
/* v=4.0; MatSetValues(B,1,&II,1,&II,&v,INSERT_VALUES);CHKERRQ(ierr); */
v=1.0; MatSetValues(B,1,&II,1,&II,&v,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
/* ierr = MatView(B,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); */
/* Set a shift: A = A - sigma*B */
ierr = PetscOptionsGetScalar(PETSC_NULL,"-sigma",&sigma,&flag);CHKERRQ(ierr);
if (flag){
sigma = -1.0 * sigma;
ierr = MatAXPY(A,sigma,B,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); /* A <- A - sigma*B */
/* ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); */
}
/* Test MatGetInertia() */
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = KSPSetType(ksp,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,A,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCCHOLESKY);CHKERRQ(ierr);
ierr = PCSetFromOptions(pc);CHKERRQ(ierr);
ierr = PCSetUp(pc);CHKERRQ(ierr);
ierr = PCFactorGetMatrix(pc,&F);CHKERRQ(ierr);
ierr = MatGetInertia(F,&nneg,&nzero,&npos);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
if (!rank){
ierr = PetscPrintf(PETSC_COMM_SELF," MatInertia: nneg: %D, nzero: %D, npos: %D\n",nneg,nzero,npos);CHKERRQ(ierr);
}
/* Destroy */
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **argv)
{
Mat M,C,K,A[3]; /* problem matrices */
PEP pep; /* polynomial eigenproblem solver context */
PetscInt m=6,n,II,Istart,Iend,i,j;
PetscScalar z=1.0;
PetscReal h;
char str[50];
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-m",&m,NULL);CHKERRQ(ierr);
if (m<2) SETERRQ(PETSC_COMM_SELF,1,"m must be at least 2");
ierr = PetscOptionsGetScalar(NULL,"-z",&z,NULL);CHKERRQ(ierr);
h = 1.0/m;
n = m*(m-1);
ierr = SlepcSNPrintfScalar(str,50,z,PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nAcoustic wave 2-D, n=%D (m=%D), z=%s\n\n",n,m,str);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrices that define the eigensystem, (k^2*M+k*C+K)x=0
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* K has a pattern similar to the 2D Laplacian */
ierr = MatCreate(PETSC_COMM_WORLD,&K);CHKERRQ(ierr);
ierr = MatSetSizes(K,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(K);CHKERRQ(ierr);
ierr = MatSetUp(K);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(K,&Istart,&Iend);CHKERRQ(ierr);
for (II=Istart;II<Iend;II++) {
i = II/m; j = II-i*m;
if (i>0) { ierr = MatSetValue(K,II,II-m,(j==m-1)?-0.5:-1.0,INSERT_VALUES);CHKERRQ(ierr); }
if (i<m-2) { ierr = MatSetValue(K,II,II+m,(j==m-1)?-0.5:-1.0,INSERT_VALUES);CHKERRQ(ierr); }
if (j>0) { ierr = MatSetValue(K,II,II-1,-1.0,INSERT_VALUES);CHKERRQ(ierr); }
if (j<m-1) { ierr = MatSetValue(K,II,II+1,-1.0,INSERT_VALUES);CHKERRQ(ierr); }
ierr = MatSetValue(K,II,II,(j==m-1)?2.0:4.0,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(K,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(K,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* C is the zero matrix except for a few nonzero elements on the diagonal */
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
if (i%m==m-1) {
ierr = MatSetValue(C,i,i,-2*PETSC_PI*h/z,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* M is a diagonal matrix */
ierr = MatCreate(PETSC_COMM_WORLD,&M);CHKERRQ(ierr);
ierr = MatSetSizes(M,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(M);CHKERRQ(ierr);
ierr = MatSetUp(M);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(M,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
if (i%m==m-1) {
ierr = MatSetValue(M,i,i,2*PETSC_PI*PETSC_PI*h*h,INSERT_VALUES);CHKERRQ(ierr);
} else {
ierr = MatSetValue(M,i,i,4*PETSC_PI*PETSC_PI*h*h,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and solve the problem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PEPCreate(PETSC_COMM_WORLD,&pep);CHKERRQ(ierr);
A[0] = K; A[1] = C; A[2] = M;
ierr = PEPSetOperators(pep,3,A);CHKERRQ(ierr);
ierr = PEPSetFromOptions(pep);CHKERRQ(ierr);
ierr = PEPSolve(pep);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PEPPrintSolution(pep,NULL);CHKERRQ(ierr);
ierr = PEPDestroy(&pep);CHKERRQ(ierr);
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&K);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
PetscInt main(PetscInt argc,char **args)
{
Mat A,As;
PetscBool flg,disp_mat=PETSC_FALSE;
PetscErrorCode ierr;
PetscMPIInt size,rank;
PetscInt i,j;
PetscScalar v,sigma2;
PetscRandom rctx;
PetscReal h2,sigma1=100.0;
PetscInt dim,Ii,J,n = 3,use_random,rstart,rend;
KSP ksp;
PC pc;
Mat F;
PetscInt nneg, nzero, npos;
PetscInitialize(&argc,&args,(char *)0,help);
#if !defined(PETSC_USE_COMPLEX)
SETERRQ(PETSC_COMM_WORLD,1,"This example requires complex numbers");
#endif
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL, "-display_mat", &disp_mat);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(PETSC_NULL,"-sigma1",&sigma1,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
dim = n*n;
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,dim,dim);CHKERRQ(ierr);
ierr = MatSetType(A,MATAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL,"-norandom",&flg);CHKERRQ(ierr);
if (flg) use_random = 0;
else use_random = 1;
if (use_random) {
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = PetscRandomSetInterval(rctx,0.0,PETSC_i);CHKERRQ(ierr);
ierr = PetscRandomGetValue(rctx,&sigma2);CHKERRQ(ierr); /* RealPart(sigma2) == 0.0 */
} else {
sigma2 = 10.0*PETSC_i;
}
h2 = 1.0/((n+1)*(n+1));
ierr = MatGetOwnershipRange(A,&rstart,&rend);CHKERRQ(ierr);
for (Ii=rstart; Ii<rend; Ii++) {
v = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {
J = Ii-n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (i<n-1) {
J = Ii+n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j>0) {
J = Ii-1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j<n-1) {
J = Ii+1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
v = 4.0 - sigma1*h2;
ierr = MatSetValues(A,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Check whether A is symmetric */
ierr = PetscOptionsHasName(PETSC_NULL, "-check_symmetric", &flg);CHKERRQ(ierr);
if (flg) {
Mat Trans;
ierr = MatTranspose(A,MAT_INITIAL_MATRIX, &Trans);
ierr = MatEqual(A, Trans, &flg);
if (!flg) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"A is not symmetric");
ierr = MatDestroy(&Trans);CHKERRQ(ierr);
}
ierr = MatSetOption(A,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
/* make A complex Hermitian */
Ii = 0; J = dim-1;
if (Ii >= rstart && Ii < rend){
v = sigma2*h2; /* RealPart(v) = 0.0 */
ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);
v = -sigma2*h2;
ierr = MatSetValues(A,1,&J,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
Ii = dim-2; J = dim-1;
if (Ii >= rstart && Ii < rend){
v = sigma2*h2; /* RealPart(v) = 0.0 */
ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);
v = -sigma2*h2;
ierr = MatSetValues(A,1,&J,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Check whether A is Hermitian */
ierr = PetscOptionsHasName(PETSC_NULL, "-check_Hermitian", &flg);CHKERRQ(ierr);
if (flg) {
Mat Hermit;
if (disp_mat){
if (!rank) printf(" A:\n");
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
ierr = MatHermitianTranspose(A,MAT_INITIAL_MATRIX, &Hermit);
if (disp_mat){
if (!rank) printf(" A_Hermitian:\n");
ierr = MatView(Hermit,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
ierr = MatEqual(A, Hermit, &flg);
if (!flg) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"A is not Hermitian");
ierr = MatDestroy(&Hermit);CHKERRQ(ierr);
}
ierr = MatSetOption(A,MAT_HERMITIAN,PETSC_TRUE);CHKERRQ(ierr);
/* Create a Hermitian matrix As in sbaij format */
ierr = MatConvert(A,MATSBAIJ,MAT_INITIAL_MATRIX,&As);CHKERRQ(ierr);
if (disp_mat){
if (!rank) {ierr = PetscPrintf(PETSC_COMM_SELF," As:\n");CHKERRQ(ierr);}
ierr = MatView(As,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
/* Test MatGetInertia() */
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = KSPSetType(ksp,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,As,As,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCCHOLESKY);CHKERRQ(ierr);
ierr = PCSetFromOptions(pc);CHKERRQ(ierr);
ierr = PCSetUp(pc);CHKERRQ(ierr);
ierr = PCFactorGetMatrix(pc,&F);CHKERRQ(ierr);
ierr = MatGetInertia(F,&nneg,&nzero,&npos);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
if (!rank){
ierr = PetscPrintf(PETSC_COMM_SELF," MatInertia: nneg: %D, nzero: %D, npos: %D\n",nneg,nzero,npos);CHKERRQ(ierr);
}
/* Free spaces */
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
if (use_random) {ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);}
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&As);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
/*
RHSJacobian - User-provided routine to compute the Jacobian of
the nonlinear right-hand-side function of the ODE.
Input Parameters:
ts - the TS context
t - current time
global_in - global input vector
dummy - optional user-defined context, as set by TSetRHSJacobian()
Output Parameters:
AA - Jacobian matrix
BB - optionally different preconditioning matrix
str - flag indicating matrix structure
Notes:
RHSJacobian computes entries for the locally owned part of the Jacobian.
- Currently, all PETSc parallel matrix formats are partitioned by
contiguous chunks of rows across the processors.
- Each processor needs to insert only elements that it owns
locally (but any non-local elements will be sent to the
appropriate processor during matrix assembly).
- Always specify global row and columns of matrix entries when
using MatSetValues().
- Here, we set all entries for a particular row at once.
- Note that MatSetValues() uses 0-based row and column numbers
in Fortran as well as in C.
*/
PetscErrorCode RHSJacobian(TS ts,PetscReal t,Vec global_in,Mat AA,Mat B,void *ctx)
{
AppCtx *appctx = (AppCtx*)ctx; /* user-defined application context */
Vec local_in = appctx->u_local; /* local ghosted input vector */
DM da = appctx->da; /* distributed array */
PetscScalar v[3],*localptr,sc;
PetscErrorCode ierr;
PetscInt i,mstart,mend,mstarts,mends,idx[3],is;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Get ready for local Jacobian computations
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Scatter ghost points to local vector, using the 2-step process
DMGlobalToLocalBegin(), DMGlobalToLocalEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = DMGlobalToLocalBegin(da,global_in,INSERT_VALUES,local_in);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,global_in,INSERT_VALUES,local_in);CHKERRQ(ierr);
/*
Get pointer to vector data
*/
ierr = VecGetArray(local_in,&localptr);CHKERRQ(ierr);
/*
Get starting and ending locally owned rows of the matrix
*/
ierr = MatGetOwnershipRange(B,&mstarts,&mends);CHKERRQ(ierr);
mstart = mstarts; mend = mends;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute entries for the locally owned part of the Jacobian.
- Currently, all PETSc parallel matrix formats are partitioned by
contiguous chunks of rows across the processors.
- Each processor needs to insert only elements that it owns
locally (but any non-local elements will be sent to the
appropriate processor during matrix assembly).
- Here, we set all entries for a particular row at once.
- We can set matrix entries either using either
MatSetValuesLocal() or MatSetValues().
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Set matrix rows corresponding to boundary data
*/
if (mstart == 0) {
v[0] = 0.0;
ierr = MatSetValues(B,1,&mstart,1,&mstart,v,INSERT_VALUES);CHKERRQ(ierr);
mstart++;
}
if (mend == appctx->m) {
mend--;
v[0] = 0.0;
ierr = MatSetValues(B,1,&mend,1,&mend,v,INSERT_VALUES);CHKERRQ(ierr);
}
/*
Set matrix rows corresponding to interior data. We construct the
matrix one row at a time.
*/
sc = 1.0/(appctx->h*appctx->h*2.0*(1.0+t)*(1.0+t));
for (i=mstart; i<mend; i++) {
idx[0] = i-1; idx[1] = i; idx[2] = i+1;
is = i - mstart + 1;
v[0] = sc*localptr[is];
v[1] = sc*(localptr[is+1] + localptr[is-1] - 4.0*localptr[is]);
v[2] = sc*localptr[is];
ierr = MatSetValues(B,1,&i,3,idx,v,INSERT_VALUES);CHKERRQ(ierr);
}
/*
Restore vector
*/
ierr = VecRestoreArray(local_in,&localptr);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Complete the matrix assembly process and set some options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Assemble matrix, using the 2-step process:
MatAssemblyBegin(), MatAssemblyEnd()
Computations can be done while messages are in transition
by placing code between these two statements.
*/
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/*
Set and option to indicate that we will never add a new nonzero location
to the matrix. If we do, it will generate an error.
*/
ierr = MatSetOption(B,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
return 0;
}
PetscErrorCode MCJPInitialLocalColor_Private(MatColoring mc,PetscInt *lperm,ISColoringValue *colors)
{
PetscInt j,i,s,e,n,bidx,cidx,idx,dist,distance=mc->dist;
Mat G=mc->mat,dG,oG;
PetscErrorCode ierr;
PetscInt *seen;
PetscInt *idxbuf;
PetscBool *boundary;
PetscInt *distbuf;
PetscInt *colormask;
PetscInt ncols;
const PetscInt *cols;
PetscBool isSeq,isMPI;
Mat_MPIAIJ *aij;
Mat_SeqAIJ *daij,*oaij;
PetscInt *di,*dj,dn;
PetscInt *oi;
PetscFunctionBegin;
ierr = PetscLogEventBegin(Mat_Coloring_Local,mc,0,0,0);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(G,&s,&e);CHKERRQ(ierr);
n=e-s;
ierr = PetscObjectTypeCompare((PetscObject)G,MATSEQAIJ,&isSeq);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)G,MATMPIAIJ,&isMPI);CHKERRQ(ierr);
if (!isSeq && !isMPI) SETERRQ(PetscObjectComm((PetscObject)G),PETSC_ERR_ARG_WRONGSTATE,"MatColoringDegrees requires an MPI/SEQAIJ Matrix");
/* get the inner matrix structure */
oG = NULL;
oi = NULL;
if (isMPI) {
aij = (Mat_MPIAIJ*)G->data;
dG = aij->A;
oG = aij->B;
daij = (Mat_SeqAIJ*)dG->data;
oaij = (Mat_SeqAIJ*)oG->data;
di = daij->i;
dj = daij->j;
oi = oaij->i;
ierr = MatGetSize(oG,&dn,NULL);CHKERRQ(ierr);
} else {
dG = G;
ierr = MatGetSize(dG,NULL,&dn);CHKERRQ(ierr);
daij = (Mat_SeqAIJ*)dG->data;
di = daij->i;
dj = daij->j;
}
ierr = PetscMalloc5(n,&colormask,n,&seen,n,&idxbuf,n,&distbuf,n,&boundary);CHKERRQ(ierr);
for (i=0;i<dn;i++) {
seen[i]=-1;
colormask[i] = -1;
boundary[i] = PETSC_FALSE;
}
/* pass one -- figure out which ones are off-boundary in the distance-n sense */
if (oG) {
for (i=0;i<dn;i++) {
bidx=-1;
/* nonempty off-diagonal, so this one is on the boundary */
if (oi[i]!=oi[i+1]) {
boundary[i] = PETSC_TRUE;
continue;
}
ncols = di[i+1]-di[i];
cols = &(dj[di[i]]);
for (j=0;j<ncols;j++) {
bidx++;
seen[cols[j]] = i;
distbuf[bidx] = 1;
idxbuf[bidx] = cols[j];
}
while (bidx >= 0) {
idx = idxbuf[bidx];
dist = distbuf[bidx];
bidx--;
if (dist < distance) {
if (oi[idx+1]!=oi[idx]) {
boundary[i] = PETSC_TRUE;
break;
}
ncols = di[idx+1]-di[idx];
cols = &(dj[di[idx]]);
for (j=0;j<ncols;j++) {
if (seen[cols[j]] != i) {
bidx++;
seen[cols[j]] = i;
idxbuf[bidx] = cols[j];
distbuf[bidx] = dist+1;
}
}
}
}
}
for (i=0;i<dn;i++) {
seen[i]=-1;
}
}
/* pass two -- color it by looking at nearby vertices and building a mask */
for (i=0;i<dn;i++) {
cidx = lperm[i];
if (!boundary[cidx]) {
bidx=-1;
ncols = di[cidx+1]-di[cidx];
cols = &(dj[di[cidx]]);
for (j=0;j<ncols;j++) {
bidx++;
seen[cols[j]] = cidx;
distbuf[bidx] = 1;
idxbuf[bidx] = cols[j];
}
while (bidx >= 0) {
idx = idxbuf[bidx];
dist = distbuf[bidx];
bidx--;
/* mask this color */
if (colors[idx] < IS_COLORING_MAX) {
colormask[colors[idx]] = cidx;
}
if (dist < distance) {
ncols = di[idx+1]-di[idx];
cols = &(dj[di[idx]]);
for (j=0;j<ncols;j++) {
if (seen[cols[j]] != cidx) {
bidx++;
seen[cols[j]] = cidx;
idxbuf[bidx] = cols[j];
distbuf[bidx] = dist+1;
}
}
}
}
/* find the lowest untaken color */
for (j=0;j<n;j++) {
if (colormask[j] != cidx || j >= mc->maxcolors) {
colors[cidx] = j;
break;
}
}
}
}
ierr = PetscFree5(colormask,seen,idxbuf,distbuf,boundary);CHKERRQ(ierr);
ierr = PetscLogEventEnd(Mat_Coloring_Local,mc,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
