int main(int argc,char **args) { PetscMPIInt size; PetscErrorCode ierr; Vec x,y,b,s1,s2; Mat A; /* linear system matrix */ Mat sA,sB,sC; /* symmetric part of the matrices */ PetscInt n,mbs=16,bs=1,nz=3,prob=1,i,j,k1,k2,col[3],lf,block, row,Ii,J,n1,inc; PetscReal norm1,norm2,rnorm,tol=PETSC_SMALL; PetscScalar neg_one = -1.0,four=4.0,value[3]; IS perm, iscol; PetscRandom rdm; PetscBool doIcc=PETSC_TRUE,equal; MatInfo minfo1,minfo2; MatFactorInfo factinfo; MatType type; PetscInitialize(&argc,&args,(char*)0,help); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size != 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"This is a uniprocessor example only!"); ierr = PetscOptionsGetInt(NULL,"-bs",&bs,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-mbs",&mbs,NULL);CHKERRQ(ierr); n = mbs*bs; ierr = MatCreate(PETSC_COMM_SELF,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr); ierr = MatSetType(A,MATSEQBAIJ);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSeqBAIJSetPreallocation(A,bs,nz,NULL);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_SELF,&sA);CHKERRQ(ierr); ierr = MatSetSizes(sA,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr); ierr = MatSetType(sA,MATSEQSBAIJ);CHKERRQ(ierr); ierr = MatSetFromOptions(sA);CHKERRQ(ierr); ierr = MatGetType(sA,&type);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)sA,MATSEQSBAIJ,&doIcc);CHKERRQ(ierr); ierr = MatSeqSBAIJSetPreallocation(sA,bs,nz,NULL);CHKERRQ(ierr); ierr = MatSetOption(sA,MAT_IGNORE_LOWER_TRIANGULAR,PETSC_TRUE);CHKERRQ(ierr); /* Test MatGetOwnershipRange() */ ierr = MatGetOwnershipRange(A,&Ii,&J);CHKERRQ(ierr); ierr = MatGetOwnershipRange(sA,&i,&j);CHKERRQ(ierr); if (i-Ii || j-J) { ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatGetOwnershipRange() in MatSBAIJ format\n");CHKERRQ(ierr); } /* Assemble matrix */ if (bs == 1) { ierr = PetscOptionsGetInt(NULL,"-test_problem",&prob,NULL);CHKERRQ(ierr); if (prob == 1) { /* tridiagonal matrix */ value[0] = -1.0; value[1] = 2.0; value[2] = -1.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,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(sA,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); } i = n - 1; col[0]=0; col[1] = n - 2; col[2] = n - 1; value[0]= 0.1; value[1]=-1; value[2]=2; ierr = MatSetValues(A,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(sA,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); i = 0; col[0] = n-1; col[1] = 1; col[2] = 0; value[0] = 0.1; value[1] = -1.0; value[2] = 2; ierr = MatSetValues(A,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(sA,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); } else if (prob ==2) { /* matrix for the five point stencil */ n1 = (PetscInt) (PetscSqrtReal((PetscReal)n) + 0.001); if (n1*n1 - n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"sqrt(n) must be a positive interger!"); for (i=0; i<n1; i++) { for (j=0; j<n1; j++) { Ii = j + n1*i; if (i>0) { J = Ii - n1; ierr = MatSetValues(A,1,&Ii,1,&J,&neg_one,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(sA,1,&Ii,1,&J,&neg_one,INSERT_VALUES);CHKERRQ(ierr); } if (i<n1-1) { J = Ii + n1; ierr = MatSetValues(A,1,&Ii,1,&J,&neg_one,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(sA,1,&Ii,1,&J,&neg_one,INSERT_VALUES);CHKERRQ(ierr); } if (j>0) { J = Ii - 1; ierr = MatSetValues(A,1,&Ii,1,&J,&neg_one,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(sA,1,&Ii,1,&J,&neg_one,INSERT_VALUES);CHKERRQ(ierr); } if (j<n1-1) { J = Ii + 1; ierr = MatSetValues(A,1,&Ii,1,&J,&neg_one,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(sA,1,&Ii,1,&J,&neg_one,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatSetValues(A,1,&Ii,1,&Ii,&four,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(sA,1,&Ii,1,&Ii,&four,INSERT_VALUES);CHKERRQ(ierr); } } } } else { /* bs > 1 */ for (block=0; block<n/bs; block++) { /* diagonal blocks */ value[0] = -1.0; value[1] = 4.0; value[2] = -1.0; for (i=1+block*bs; i<bs-1+block*bs; i++) { col[0] = i-1; col[1] = i; col[2] = i+1; ierr = MatSetValues(A,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(sA,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); } i = bs - 1+block*bs; col[0] = bs - 2+block*bs; col[1] = bs - 1+block*bs; value[0]=-1.0; value[1]=4.0; ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(sA,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); i = 0+block*bs; col[0] = 0+block*bs; col[1] = 1+block*bs; value[0]=4.0; value[1] = -1.0; ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(sA,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); } /* off-diagonal blocks */ value[0]=-1.0; for (i=0; i<(n/bs-1)*bs; i++) { col[0]=i+bs; ierr = MatSetValues(A,1,&i,1,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(sA,1,&i,1,col,value,INSERT_VALUES);CHKERRQ(ierr); col[0]=i; row=i+bs; ierr = MatSetValues(A,1,&row,1,col,value,INSERT_VALUES);CHKERRQ(ierr); ierr = MatSetValues(sA,1,&row,1,col,value,INSERT_VALUES);CHKERRQ(ierr); } } ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyBegin(sA,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(sA,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* Test MatGetInfo() of A and sA */ ierr = MatGetInfo(A,MAT_LOCAL,&minfo1);CHKERRQ(ierr); ierr = MatGetInfo(sA,MAT_LOCAL,&minfo2);CHKERRQ(ierr); /* printf("A matrix nonzeros (BAIJ format) = %d, allocated nonzeros= %d\n", (int)minfo1.nz_used,(int)minfo1.nz_allocated); printf("sA matrix nonzeros(SBAIJ format) = %d, allocated nonzeros= %d\n", (int)minfo2.nz_used,(int)minfo2.nz_allocated); */ i = (int) (minfo1.nz_used - minfo2.nz_used); j = (int) (minfo1.nz_allocated - minfo2.nz_allocated); k1 = (int) (minfo1.nz_allocated - minfo1.nz_used); k2 = (int) (minfo2.nz_allocated - minfo2.nz_used); if (i < 0 || j < 0 || k1 < 0 || k2 < 0) { ierr = PetscPrintf(PETSC_COMM_SELF,"Error (compare A and sA): MatGetInfo()\n");CHKERRQ(ierr); } /* Test MatDuplicate() */ ierr = MatNorm(A,NORM_FROBENIUS,&norm1);CHKERRQ(ierr); ierr = MatDuplicate(sA,MAT_COPY_VALUES,&sB);CHKERRQ(ierr); ierr = MatEqual(sA,sB,&equal);CHKERRQ(ierr); if (!equal) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMETYPE,"Error in MatDuplicate()"); /* Test MatNorm() */ ierr = MatNorm(A,NORM_FROBENIUS,&norm1);CHKERRQ(ierr); ierr = MatNorm(sB,NORM_FROBENIUS,&norm2);CHKERRQ(ierr); rnorm = PetscAbsReal(norm1-norm2)/norm2; if (rnorm > tol) { ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatNorm_FROBENIUS, NormA=%16.14e NormsB=%16.14e\n",norm1,norm2);CHKERRQ(ierr); } ierr = MatNorm(A,NORM_INFINITY,&norm1);CHKERRQ(ierr); ierr = MatNorm(sB,NORM_INFINITY,&norm2);CHKERRQ(ierr); rnorm = PetscAbsReal(norm1-norm2)/norm2; if (rnorm > tol) { ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatNorm_INFINITY(), NormA=%16.14e NormsB=%16.14e\n",norm1,norm2);CHKERRQ(ierr); } ierr = MatNorm(A,NORM_1,&norm1);CHKERRQ(ierr); ierr = MatNorm(sB,NORM_1,&norm2);CHKERRQ(ierr); rnorm = PetscAbsReal(norm1-norm2)/norm2; if (rnorm > tol) { ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatNorm_INFINITY(), NormA=%16.14e NormsB=%16.14e\n",norm1,norm2);CHKERRQ(ierr); } /* Test MatGetInfo(), MatGetSize(), MatGetBlockSize() */ ierr = MatGetInfo(A,MAT_LOCAL,&minfo1);CHKERRQ(ierr); ierr = MatGetInfo(sB,MAT_LOCAL,&minfo2);CHKERRQ(ierr); /* printf("matrix nonzeros (BAIJ format) = %d, allocated nonzeros= %d\n", (int)minfo1.nz_used,(int)minfo1.nz_allocated); printf("matrix nonzeros(SBAIJ format) = %d, allocated nonzeros= %d\n", (int)minfo2.nz_used,(int)minfo2.nz_allocated); */ i = (int) (minfo1.nz_used - minfo2.nz_used); j = (int) (minfo1.nz_allocated - minfo2.nz_allocated); k1 = (int) (minfo1.nz_allocated - minfo1.nz_used); k2 = (int) (minfo2.nz_allocated - minfo2.nz_used); if (i < 0 || j < 0 || k1 < 0 || k2 < 0) { ierr = PetscPrintf(PETSC_COMM_SELF,"Error(compare A and sB): MatGetInfo()\n");CHKERRQ(ierr); } ierr = MatGetSize(A,&Ii,&J);CHKERRQ(ierr); ierr = MatGetSize(sB,&i,&j);CHKERRQ(ierr); if (i-Ii || j-J) { PetscPrintf(PETSC_COMM_SELF,"Error: MatGetSize()\n");CHKERRQ(ierr); } ierr = MatGetBlockSize(A, &Ii);CHKERRQ(ierr); ierr = MatGetBlockSize(sB, &i);CHKERRQ(ierr); if (i-Ii) { ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatGetBlockSize()\n");CHKERRQ(ierr); } ierr = PetscRandomCreate(PETSC_COMM_SELF,&rdm);CHKERRQ(ierr); ierr = PetscRandomSetFromOptions(rdm);CHKERRQ(ierr); ierr = VecCreateSeq(PETSC_COMM_SELF,n,&x);CHKERRQ(ierr); ierr = VecDuplicate(x,&s1);CHKERRQ(ierr); ierr = VecDuplicate(x,&s2);CHKERRQ(ierr); ierr = VecDuplicate(x,&y);CHKERRQ(ierr); ierr = VecDuplicate(x,&b);CHKERRQ(ierr); ierr = VecSetRandom(x,rdm);CHKERRQ(ierr); /* Test MatDiagonalScale(), MatGetDiagonal(), MatScale() */ #if !defined(PETSC_USE_COMPLEX) /* Scaling matrix with complex numbers results non-spd matrix, causing crash of MatForwardSolve() and MatBackwardSolve() */ ierr = MatDiagonalScale(A,x,x);CHKERRQ(ierr); ierr = MatDiagonalScale(sB,x,x);CHKERRQ(ierr); ierr = MatMultEqual(A,sB,10,&equal);CHKERRQ(ierr); if (!equal) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMETYPE,"Error in MatDiagonalScale"); ierr = MatGetDiagonal(A,s1);CHKERRQ(ierr); ierr = MatGetDiagonal(sB,s2);CHKERRQ(ierr); ierr = VecAXPY(s2,neg_one,s1);CHKERRQ(ierr); ierr = VecNorm(s2,NORM_1,&norm1);CHKERRQ(ierr); if (norm1>tol) { ierr = PetscPrintf(PETSC_COMM_SELF,"Error:MatGetDiagonal(), ||s1-s2||=%g\n",(double)norm1);CHKERRQ(ierr); } { PetscScalar alpha=0.1; ierr = MatScale(A,alpha);CHKERRQ(ierr); ierr = MatScale(sB,alpha);CHKERRQ(ierr); } #endif /* Test MatGetRowMaxAbs() */ ierr = MatGetRowMaxAbs(A,s1,NULL);CHKERRQ(ierr); ierr = MatGetRowMaxAbs(sB,s2,NULL);CHKERRQ(ierr); ierr = VecNorm(s1,NORM_1,&norm1);CHKERRQ(ierr); ierr = VecNorm(s2,NORM_1,&norm2);CHKERRQ(ierr); norm1 -= norm2; if (norm1<-tol || norm1>tol) { ierr = PetscPrintf(PETSC_COMM_SELF,"Error:MatGetRowMaxAbs() \n");CHKERRQ(ierr); } /* Test MatMult() */ for (i=0; i<40; i++) { ierr = VecSetRandom(x,rdm);CHKERRQ(ierr); ierr = MatMult(A,x,s1);CHKERRQ(ierr); ierr = MatMult(sB,x,s2);CHKERRQ(ierr); ierr = VecNorm(s1,NORM_1,&norm1);CHKERRQ(ierr); ierr = VecNorm(s2,NORM_1,&norm2);CHKERRQ(ierr); norm1 -= norm2; if (norm1<-tol || norm1>tol) { ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatMult(), norm1-norm2: %g\n",(double)norm1);CHKERRQ(ierr); } } /* MatMultAdd() */ for (i=0; i<40; i++) { ierr = VecSetRandom(x,rdm);CHKERRQ(ierr); ierr = VecSetRandom(y,rdm);CHKERRQ(ierr); ierr = MatMultAdd(A,x,y,s1);CHKERRQ(ierr); ierr = MatMultAdd(sB,x,y,s2);CHKERRQ(ierr); ierr = VecNorm(s1,NORM_1,&norm1);CHKERRQ(ierr); ierr = VecNorm(s2,NORM_1,&norm2);CHKERRQ(ierr); norm1 -= norm2; if (norm1<-tol || norm1>tol) { ierr = PetscPrintf(PETSC_COMM_SELF,"Error:MatMultAdd(), norm1-norm2: %g\n",(double)norm1);CHKERRQ(ierr); } } /* Test MatCholeskyFactor(), MatICCFactor() with natural ordering */ ierr = MatGetOrdering(A,MATORDERINGNATURAL,&perm,&iscol);CHKERRQ(ierr); ierr = ISDestroy(&iscol);CHKERRQ(ierr); norm1 = tol; inc = bs; /* initialize factinfo */ ierr = PetscMemzero(&factinfo,sizeof(MatFactorInfo));CHKERRQ(ierr); for (lf=-1; lf<10; lf += inc) { if (lf==-1) { /* Cholesky factor of sB (duplicate sA) */ factinfo.fill = 5.0; ierr = MatGetFactor(sB,MATSOLVERPETSC,MAT_FACTOR_CHOLESKY,&sC);CHKERRQ(ierr); ierr = MatCholeskyFactorSymbolic(sC,sB,perm,&factinfo);CHKERRQ(ierr); } else if (!doIcc) break; else { /* incomplete Cholesky factor */ factinfo.fill = 5.0; factinfo.levels = lf; ierr = MatGetFactor(sB,MATSOLVERPETSC,MAT_FACTOR_ICC,&sC);CHKERRQ(ierr); ierr = MatICCFactorSymbolic(sC,sB,perm,&factinfo);CHKERRQ(ierr); } ierr = MatCholeskyFactorNumeric(sC,sB,&factinfo);CHKERRQ(ierr); /* MatView(sC, PETSC_VIEWER_DRAW_WORLD); */ /* test MatGetDiagonal on numeric factor */ /* if (lf == -1) { ierr = MatGetDiagonal(sC,s1);CHKERRQ(ierr); printf(" in ex74.c, diag: \n"); ierr = VecView(s1,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); } */ ierr = MatMult(sB,x,b);CHKERRQ(ierr); /* test MatForwardSolve() and MatBackwardSolve() */ if (lf == -1) { ierr = MatForwardSolve(sC,b,s1);CHKERRQ(ierr); ierr = MatBackwardSolve(sC,s1,s2);CHKERRQ(ierr); ierr = VecAXPY(s2,neg_one,x);CHKERRQ(ierr); ierr = VecNorm(s2,NORM_2,&norm2);CHKERRQ(ierr); if (10*norm1 < norm2) { ierr = PetscPrintf(PETSC_COMM_SELF,"MatForwardSolve and BackwardSolve: Norm of error=%g, bs=%D\n",(double)norm2,bs);CHKERRQ(ierr); } } /* test MatSolve() */ ierr = MatSolve(sC,b,y);CHKERRQ(ierr); ierr = MatDestroy(&sC);CHKERRQ(ierr); /* Check the error */ ierr = VecAXPY(y,neg_one,x);CHKERRQ(ierr); ierr = VecNorm(y,NORM_2,&norm2);CHKERRQ(ierr); if (10*norm1 < norm2 && lf-inc != -1) { ierr = PetscPrintf(PETSC_COMM_SELF,"lf=%D, %D, Norm of error=%g, %g\n",lf-inc,lf,(double)norm1,(double)norm2);CHKERRQ(ierr); } norm1 = norm2; if (norm2 < tol && lf != -1) break; } ierr = ISDestroy(&perm);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&sB);CHKERRQ(ierr); ierr = MatDestroy(&sA);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&y);CHKERRQ(ierr); ierr = VecDestroy(&s1);CHKERRQ(ierr); ierr = VecDestroy(&s2);CHKERRQ(ierr); ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = PetscRandomDestroy(&rdm);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }

int main(int argc,char **argv) { PetscErrorCode ierr; Mat seqmat,mpimat; PetscMPIInt rank; PetscScalar value[3],*vals; PetscInt i,col[3],n=5,bs=1; PetscInitialize(&argc,&argv,(char*)0,help); ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-bs",&bs,NULL);CHKERRQ(ierr); /* Create seqaij matrices of size (n+rank) by n */ ierr = MatCreate(PETSC_COMM_SELF,&seqmat);CHKERRQ(ierr); ierr = MatSetSizes(seqmat,(n+rank)*bs,PETSC_DECIDE,PETSC_DECIDE,n*bs);CHKERRQ(ierr); ierr = MatSetFromOptions(seqmat);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(seqmat,3*bs,NULL);CHKERRQ(ierr); ierr = MatSeqBAIJSetPreallocation(seqmat,bs,3,NULL);CHKERRQ(ierr); if (bs == 1) { value[0] = -1.0; value[1] = 2.0; value[2] = -1.0; for (i=1; i<n-1; i++) { col[0] = i-1; col[1] = i; col[2] = i+1; ierr = MatSetValues(seqmat,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr); } i = n - 1; col[0] = n - 2; col[1] = n - 1; ierr = MatSetValues(seqmat,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); i = 0; col[0] = 0; col[1] = 1; value[0] = 2.0; value[1] = -1.0; ierr = MatSetValues(seqmat,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr); } else { PetscInt *rows,*cols,j; ierr = PetscMalloc3(bs*bs,&vals,bs,&rows,bs,&cols);CHKERRQ(ierr); /* diagonal blocks */ for (i=0; i<bs*bs; i++) vals[i] = 2.0; for (i=0; i<n*bs; i+=bs) { for (j=0; j<bs; j++) {rows[j] = i+j; cols[j] = i+j;} ierr = MatSetValues(seqmat,bs,rows,bs,cols,vals,INSERT_VALUES);CHKERRQ(ierr); } /* off-diagonal blocks */ for (i=0; i<bs*bs; i++) vals[i] = -1.0; for (i=0; i<(n-1)*bs; i+=bs) { for (j=0; j<bs; j++) {rows[j] = i+j; cols[j] = i+bs+j;} ierr = MatSetValues(seqmat,bs,rows,bs,cols,vals,INSERT_VALUES);CHKERRQ(ierr); } ierr = PetscFree3(vals,rows,cols);CHKERRQ(ierr); } ierr = MatAssemblyBegin(seqmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(seqmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); if (rank == 1) { printf("[%d] seqmat:\n",rank); ierr = MatView(seqmat,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); } ierr = MatCreateMPIMatConcatenateSeqMat(PETSC_COMM_WORLD,seqmat,PETSC_DECIDE,MAT_INITIAL_MATRIX,&mpimat);CHKERRQ(ierr); ierr = MatCreateMPIMatConcatenateSeqMat(PETSC_COMM_WORLD,seqmat,PETSC_DECIDE,MAT_REUSE_MATRIX,&mpimat);CHKERRQ(ierr); ierr = MatView(mpimat,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = MatDestroy(&seqmat);CHKERRQ(ierr); ierr = MatDestroy(&mpimat);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }

int main(int argc,char **args) { Vec x,b,u; /* approx solution, RHS, exact solution */ Mat A; /* linear system matrix */ KSP ksp; /* KSP context */ PetscErrorCode ierr; PetscInt n = 10,its, dim,p = 1,use_random; PetscScalar none = -1.0,pfive = 0.5; PetscReal norm; PetscRandom rctx; TestType type; PetscBool flg; PetscInitialize(&argc,&args,(char *)0,help); ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(PETSC_NULL,"-p",&p,PETSC_NULL);CHKERRQ(ierr); switch (p) { case 1: type = TEST_1; dim = n; break; case 2: type = TEST_2; dim = n; break; case 3: type = TEST_3; dim = n; break; case 4: type = HELMHOLTZ_1; dim = n*n; break; case 5: type = HELMHOLTZ_2; dim = n*n; break; default: type = TEST_1; dim = n; } /* Create vectors */ ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr); ierr = VecSetSizes(x,PETSC_DECIDE,dim);CHKERRQ(ierr); ierr = VecSetFromOptions(x);CHKERRQ(ierr); ierr = VecDuplicate(x,&b);CHKERRQ(ierr); ierr = VecDuplicate(x,&u);CHKERRQ(ierr); use_random = 1; flg = PETSC_FALSE; ierr = PetscOptionsGetBool(PETSC_NULL,"-norandom",&flg,PETSC_NULL);CHKERRQ(ierr); if (flg) { use_random = 0; ierr = VecSet(u,pfive);CHKERRQ(ierr); } else { ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr); ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr); ierr = VecSetRandom(u,rctx);CHKERRQ(ierr); } /* Create and assemble matrix */ ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,dim,dim);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSetUp(A);CHKERRQ(ierr); ierr = FormTestMatrix(A,n,type);CHKERRQ(ierr); ierr = MatMult(A,u,b);CHKERRQ(ierr); flg = PETSC_FALSE; ierr = PetscOptionsGetBool(PETSC_NULL,"-printout",&flg,PETSC_NULL);CHKERRQ(ierr); if (flg) { ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = VecView(u,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = VecView(b,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } /* Create KSP context; set operators and options; solve linear system */ ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr); ierr = KSPSetOperators(ksp,A,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr); ierr = KSPView(ksp,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); /* Check 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 %G,Iterations %D\n",norm,its);CHKERRQ(ierr); /* Free work space */ ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&u);CHKERRQ(ierr); ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); if (use_random) {ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);} ierr = KSPDestroy(&ksp);CHKERRQ(ierr); ierr = PetscFinalize(); 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; }

Modified from the code contributed by Yaning Liu @lbl.gov \n\n"; /* Example: mpiexec -n <np> ./ex103 mpiexec -n <np> ./ex103 -mat_type elemental -mat_view mpiexec -n <np> ./ex103 -mat_type aij */ #include <petscmat.h> #undef __FUNCT__ #define __FUNCT__ "main" int main(int argc, char** argv) { Mat A,A_elemental; PetscInt i,j,M=10,N=5,nrows,ncols; PetscErrorCode ierr; PetscMPIInt rank,size; IS isrows,iscols; const PetscInt *rows,*cols; PetscScalar *v; MatType type; PetscBool isDense,isAIJ,flg; ierr = PetscInitialize(&argc, &argv, (char*)0, help);if (ierr) return ierr; #if !defined(PETSC_HAVE_ELEMENTAL) SETERRQ(PETSC_COMM_WORLD,1,"This example requires ELEMENTAL"); #endif ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); /* Creat a matrix */ 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); /* 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++) { if (size == 1) { v[i*ncols+j] = (PetscScalar)(i+j); } else { v[i*ncols+j] = (PetscScalar)rank+j*0.1; } } } 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 = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%D] local nrows %D, ncols %D\n",rank,nrows,ncols);CHKERRQ(ierr); //ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,PETSC_STDOUT);CHKERRQ(ierr); /* Test MatSetValues() by converting A to A_elemental */ ierr = MatGetType(A,&type);CHKERRQ(ierr); if (size == 1) { ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isDense);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isAIJ);CHKERRQ(ierr); } else { ierr = PetscObjectTypeCompare((PetscObject)A,MATMPIDENSE,&isDense);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)A,MATMPIAIJ,&isAIJ);CHKERRQ(ierr); } if (isDense || isAIJ) { Mat Aexplicit; ierr = MatConvert(A, MATELEMENTAL, MAT_INITIAL_MATRIX, &A_elemental);CHKERRQ(ierr); ierr = MatComputeExplicitOperator(A_elemental,&Aexplicit);CHKERRQ(ierr); ierr = MatMultEqual(Aexplicit,A_elemental,5,&flg);CHKERRQ(ierr); if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Aexplicit != A_elemental."); ierr = MatDestroy(&Aexplicit);CHKERRQ(ierr); /* Test MAT_REUSE_MATRIX which is only supported for inplace conversion */ ierr = MatConvert(A, MATELEMENTAL, MAT_INPLACE_MATRIX, &A);CHKERRQ(ierr); ierr = MatMultEqual(A_elemental,A,5,&flg);CHKERRQ(ierr); if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"A_elemental != A."); ierr = MatDestroy(&A_elemental);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 = PetscFree(v);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }

int main(int argc,char **args) { Mat C; int i,m = 5,rank,size,N,start,end,M; int ierr,idx[4]; PetscBool flg; PetscScalar Ke[16]; PetscReal h; Vec u,b; KSP ksp; MatNullSpace nullsp; PetscInitialize(&argc,&args,(char*)0,help); ierr = PetscOptionsGetInt(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); start = rank*(M/size) + ((M%size) < rank ? (M%size) : rank); end = start + M/size + ((M%size) > rank); /* Assemble matrix */ ierr = FormElementStiffness(h*h,Ke); /* element stiffness for Laplacian */ 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 right-hand-side and solution vectors */ ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr); ierr = VecSetSizes(u,PETSC_DECIDE,N);CHKERRQ(ierr); ierr = VecSetFromOptions(u);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)u,"Approx. Solution");CHKERRQ(ierr); ierr = VecDuplicate(u,&b);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)b,"Right hand side");CHKERRQ(ierr); ierr = VecSet(u,1.0);CHKERRQ(ierr); ierr = MatMult(C,u,b);CHKERRQ(ierr); ierr = VecSet(u,0.0);CHKERRQ(ierr); /* Solve linear system */ ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr); ierr = KSPSetOperators(ksp,C,C,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); ierr = KSPSetInitialGuessNonzero(ksp,PETSC_TRUE);CHKERRQ(ierr); flg = PETSC_FALSE; ierr = PetscOptionsGetBool(NULL,"-fixnullspace",&flg,NULL);CHKERRQ(ierr); if (flg) { ierr = MatNullSpaceCreate(PETSC_COMM_WORLD,PETSC_TRUE,0,NULL,&nullsp);CHKERRQ(ierr); ierr = KSPSetNullSpace(ksp,nullsp);CHKERRQ(ierr); ierr = MatNullSpaceDestroy(&&nullsp);CHKERRQ(ierr); } ierr = KSPSolve(ksp,b,u);CHKERRQ(ierr); /* Free work space */ ierr = KSPDestroy(&ksp);CHKERRQ(ierr); ierr = VecDestroy(&u);CHKERRQ(ierr); ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }

void g2_correlation(PetscScalar ***g2_values,Vec dm0,PetscInt n_tau,PetscReal tau_max,PetscInt n_st,PetscReal st_max,PetscInt number_of_ops,...){ TSCtx tsctx; PetscReal st_dt,previous_start_time,this_start_time,dt; PetscReal tau_t_max,dt_tau; PetscInt i,j,dim,steps_max; Mat A_star_A,tmp_mat; Vec init_dm; va_list ap; /*Explicitly construct our jump matrix by adding up all of the operators * \rho = A \rho A^\dag * Vectorized: * \rho = (A* \cross A) \rho */ dim = total_levels*total_levels; //Assumes Lindblad MatCreate(PETSC_COMM_WORLD,&tmp_mat); MatSetType(tmp_mat,MATMPIAIJ); MatSetSizes(tmp_mat,PETSC_DECIDE,PETSC_DECIDE,dim,dim); MatSetFromOptions(tmp_mat); MatMPIAIJSetPreallocation(tmp_mat,4,NULL,4,NULL); va_start(ap,number_of_ops); //Get A* \cross I vadd_ops_to_mat(tmp_mat,1,number_of_ops,ap); va_end(ap); MatCreate(PETSC_COMM_WORLD,&tsctx.I_cross_A); MatSetType(tsctx.I_cross_A,MATMPIAIJ); MatSetSizes(tsctx.I_cross_A,PETSC_DECIDE,PETSC_DECIDE,dim,dim); MatSetFromOptions(tsctx.I_cross_A); MatMPIAIJSetPreallocation(tsctx.I_cross_A,4,NULL,4,NULL); va_start(ap,number_of_ops); //Get I_cross_A vadd_ops_to_mat(tsctx.I_cross_A,-1,number_of_ops,ap); va_end(ap); //Get (A* \cross I) (I \cross A) MatMatMult(tmp_mat,tsctx.I_cross_A,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&A_star_A); MatDestroy(&tmp_mat); VecDuplicate(dm0,&(tsctx.tmp_dm)); VecDuplicate(dm0,&(tsctx.tmp_dm2)); VecDuplicate(dm0,&init_dm); //Arbitrary, set this better steps_max = 51000; dt = 0.025; //Allocate memory for g2 (*g2_values) = (PetscScalar **)malloc((n_st+1)*sizeof(PetscScalar *)); for (i=0;i<n_st+1;i++){ (*g2_values)[i] = (PetscScalar *)malloc((n_tau+1)*sizeof(PetscScalar)); for (j=0;j<n_tau+1;j++){ (*g2_values)[i][j] = 0.0; } } tsctx.g2_values = (*g2_values); set_ts_monitor_ctx(_g2_ts_monitor,&tsctx); st_dt = st_max/n_st; previous_start_time = 0; tsctx.i_st = 0; tsctx.i_st = tsctx.i_st + 1; //Why? for (this_start_time=st_dt;this_start_time<=st_max;this_start_time+=st_dt){ //Go from previous start time to this_start_time tsctx.tau_evolve = 0; dt = (this_start_time - previous_start_time)/500; //500 is arbitrary, should be picked better time_step(dm0,previous_start_time,this_start_time,dt,steps_max); //Timestep through taus tau_t_max = this_start_time + tau_max; dt_tau = (tau_t_max - this_start_time)/n_tau; /* * Force an 'emission' to get A \rho A^\dag terms * We already have A* \cross A - we just do the multiplication */ tsctx.tau_evolve = 1; //Copy the timestepped dm into our init_dm for tau sweep VecCopy(dm0,init_dm); MatMult(A_star_A,dm0,init_dm); //init_dm = A * dm0 tsctx.i_tau = 0; time_step(init_dm,this_start_time,tau_t_max,dt_tau,steps_max); previous_start_time = this_start_time; tsctx.i_st = tsctx.i_st + 1; } return; }

PetscErrorCode PCGAMGProlongator_Classical_Direct(PC pc, const Mat A, const Mat G, PetscCoarsenData *agg_lists,Mat *P) { PetscErrorCode ierr; MPI_Comm comm; PetscReal *Amax_pos,*Amax_neg; Mat lA,gA; /* on and off diagonal matrices */ PetscInt fn; /* fine local blocked sizes */ PetscInt cn; /* coarse local blocked sizes */ PetscInt gn; /* size of the off-diagonal fine vector */ PetscInt fs,fe; /* fine (row) ownership range*/ PetscInt cs,ce; /* coarse (column) ownership range */ PetscInt i,j; /* indices! */ PetscBool iscoarse; /* flag for determining if a node is coarse */ PetscInt *lcid,*gcid; /* on and off-processor coarse unknown IDs */ PetscInt *lsparse,*gsparse; /* on and off-processor sparsity patterns for prolongator */ PetscScalar pij; const PetscScalar *rval; const PetscInt *rcol; PetscScalar g_pos,g_neg,a_pos,a_neg,diag,invdiag,alpha,beta; Vec F; /* vec of coarse size */ Vec C; /* vec of fine size */ Vec gF; /* vec of off-diagonal fine size */ MatType mtype; PetscInt c_indx; PetscScalar c_scalar; PetscInt ncols,col; PetscInt row_f,row_c; PetscInt cmax=0,idx; PetscScalar *pvals; PetscInt *pcols; PC_MG *mg = (PC_MG*)pc->data; PC_GAMG *gamg = (PC_GAMG*)mg->innerctx; PetscFunctionBegin; comm = ((PetscObject)pc)->comm; ierr = MatGetOwnershipRange(A,&fs,&fe); CHKERRQ(ierr); fn = (fe - fs); ierr = MatGetVecs(A,&F,NULL);CHKERRQ(ierr); /* get the number of local unknowns and the indices of the local unknowns */ ierr = PetscMalloc(sizeof(PetscInt)*fn,&lsparse);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscInt)*fn,&gsparse);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscInt)*fn,&lcid);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscReal)*fn,&Amax_pos);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscReal)*fn,&Amax_neg);CHKERRQ(ierr); /* count the number of coarse unknowns */ cn = 0; for (i=0;i<fn;i++) { /* filter out singletons */ ierr = PetscCDEmptyAt(agg_lists,i,&iscoarse); CHKERRQ(ierr); lcid[i] = -1; if (!iscoarse) { cn++; } } /* create the coarse vector */ ierr = VecCreateMPI(comm,cn,PETSC_DECIDE,&C);CHKERRQ(ierr); ierr = VecGetOwnershipRange(C,&cs,&ce);CHKERRQ(ierr); /* construct a global vector indicating the global indices of the coarse unknowns */ cn = 0; for (i=0;i<fn;i++) { ierr = PetscCDEmptyAt(agg_lists,i,&iscoarse); CHKERRQ(ierr); if (!iscoarse) { lcid[i] = cs+cn; cn++; } else { lcid[i] = -1; } *((PetscInt *)&c_scalar) = lcid[i]; c_indx = fs+i; ierr = VecSetValues(F,1,&c_indx,&c_scalar,INSERT_VALUES);CHKERRQ(ierr); } ierr = VecAssemblyBegin(F);CHKERRQ(ierr); ierr = VecAssemblyEnd(F);CHKERRQ(ierr); /* determine the biggest off-diagonal entries in each row */ for (i=fs;i<fe;i++) { Amax_pos[i-fs] = 0.; Amax_neg[i-fs] = 0.; ierr = MatGetRow(A,i,&ncols,&rcol,&rval);CHKERRQ(ierr); for(j=0;j<ncols;j++){ if ((PetscRealPart(-rval[j]) > Amax_neg[i-fs]) && i != rcol[j]) Amax_neg[i-fs] = PetscAbsScalar(rval[j]); if ((PetscRealPart(rval[j]) > Amax_pos[i-fs]) && i != rcol[j]) Amax_pos[i-fs] = PetscAbsScalar(rval[j]); } if (ncols > cmax) cmax = ncols; ierr = MatRestoreRow(A,i,&ncols,&rcol,&rval);CHKERRQ(ierr); } ierr = PetscMalloc(sizeof(PetscInt)*cmax,&pcols);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscScalar)*cmax,&pvals);CHKERRQ(ierr); /* split the operator into two */ ierr = PCGAMGClassicalGraphSplitting_Private(A,&lA,&gA);CHKERRQ(ierr); /* scatter to the ghost vector */ ierr = PCGAMGClassicalCreateGhostVector_Private(A,&gF,NULL);CHKERRQ(ierr); ierr = PCGAMGClassicalGhost_Private(A,F,gF);CHKERRQ(ierr); if (gA) { ierr = VecGetSize(gF,&gn);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscInt)*gn,&gcid);CHKERRQ(ierr); for (i=0;i<gn;i++) { ierr = VecGetValues(gF,1,&i,&c_scalar);CHKERRQ(ierr); gcid[i] = *((PetscInt *)&c_scalar); } } ierr = VecDestroy(&F);CHKERRQ(ierr); ierr = VecDestroy(&gF);CHKERRQ(ierr); ierr = VecDestroy(&C);CHKERRQ(ierr); /* count the on and off processor sparsity patterns for the prolongator */ for (i=0;i<fn;i++) { /* on */ lsparse[i] = 0; gsparse[i] = 0; if (lcid[i] >= 0) { lsparse[i] = 1; gsparse[i] = 0; } else { ierr = MatGetRow(lA,i,&ncols,&rcol,&rval);CHKERRQ(ierr); for (j = 0;j < ncols;j++) { col = rcol[j]; if (lcid[col] >= 0 && (PetscRealPart(rval[j]) > gamg->threshold*Amax_pos[i] || PetscRealPart(-rval[j]) > gamg->threshold*Amax_neg[i])) { lsparse[i] += 1; } } ierr = MatRestoreRow(lA,i,&ncols,&rcol,&rval);CHKERRQ(ierr); /* off */ if (gA) { ierr = MatGetRow(gA,i,&ncols,&rcol,&rval);CHKERRQ(ierr); for (j = 0; j < ncols; j++) { col = rcol[j]; if (gcid[col] >= 0 && (PetscRealPart(rval[j]) > gamg->threshold*Amax_pos[i] || PetscRealPart(-rval[j]) > gamg->threshold*Amax_neg[i])) { gsparse[i] += 1; } } ierr = MatRestoreRow(gA,i,&ncols,&rcol,&rval);CHKERRQ(ierr); } } } /* preallocate and create the prolongator */ ierr = MatCreate(comm,P); CHKERRQ(ierr); ierr = MatGetType(G,&mtype);CHKERRQ(ierr); ierr = MatSetType(*P,mtype);CHKERRQ(ierr); ierr = MatSetSizes(*P,fn,cn,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr); ierr = MatMPIAIJSetPreallocation(*P,0,lsparse,0,gsparse);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(*P,0,lsparse);CHKERRQ(ierr); /* loop over local fine nodes -- get the diagonal, the sum of positive and negative strong and weak weights, and set up the row */ for (i = 0;i < fn;i++) { /* determine on or off */ row_f = i + fs; row_c = lcid[i]; if (row_c >= 0) { pij = 1.; ierr = MatSetValues(*P,1,&row_f,1,&row_c,&pij,INSERT_VALUES);CHKERRQ(ierr); } else { g_pos = 0.; g_neg = 0.; a_pos = 0.; a_neg = 0.; diag = 0.; /* local connections */ ierr = MatGetRow(lA,i,&ncols,&rcol,&rval);CHKERRQ(ierr); for (j = 0; j < ncols; j++) { col = rcol[j]; if (lcid[col] >= 0 && (PetscRealPart(rval[j]) > gamg->threshold*Amax_pos[i] || PetscRealPart(-rval[j]) > gamg->threshold*Amax_neg[i])) { if (PetscRealPart(rval[j]) > 0.) { g_pos += rval[j]; } else { g_neg += rval[j]; } } if (col != i) { if (PetscRealPart(rval[j]) > 0.) { a_pos += rval[j]; } else { a_neg += rval[j]; } } else { diag = rval[j]; } } ierr = MatRestoreRow(lA,i,&ncols,&rcol,&rval);CHKERRQ(ierr); /* ghosted connections */ if (gA) { ierr = MatGetRow(gA,i,&ncols,&rcol,&rval);CHKERRQ(ierr); for (j = 0; j < ncols; j++) { col = rcol[j]; if (gcid[col] >= 0 && (PetscRealPart(rval[j]) > gamg->threshold*Amax_pos[i] || PetscRealPart(-rval[j]) > gamg->threshold*Amax_neg[i])) { if (PetscRealPart(rval[j]) > 0.) { g_pos += rval[j]; } else { g_neg += rval[j]; } } if (PetscRealPart(rval[j]) > 0.) { a_pos += rval[j]; } else { a_neg += rval[j]; } } ierr = MatRestoreRow(gA,i,&ncols,&rcol,&rval);CHKERRQ(ierr); } if (g_neg == 0.) { alpha = 0.; } else { alpha = -a_neg/g_neg; } if (g_pos == 0.) { diag += a_pos; beta = 0.; } else { beta = -a_pos/g_pos; } if (diag == 0.) { invdiag = 0.; } else invdiag = 1. / diag; /* on */ ierr = MatGetRow(lA,i,&ncols,&rcol,&rval);CHKERRQ(ierr); idx = 0; for (j = 0;j < ncols;j++) { col = rcol[j]; if (lcid[col] >= 0 && (PetscRealPart(rval[j]) > gamg->threshold*Amax_pos[i] || PetscRealPart(-rval[j]) > gamg->threshold*Amax_neg[i])) { row_f = i + fs; row_c = lcid[col]; /* set the values for on-processor ones */ if (PetscRealPart(rval[j]) < 0.) { pij = rval[j]*alpha*invdiag; } else { pij = rval[j]*beta*invdiag; } if (PetscAbsScalar(pij) != 0.) { pvals[idx] = pij; pcols[idx] = row_c; idx++; } } } ierr = MatRestoreRow(lA,i,&ncols,&rcol,&rval);CHKERRQ(ierr); /* off */ if (gA) { ierr = MatGetRow(gA,i,&ncols,&rcol,&rval);CHKERRQ(ierr); for (j = 0; j < ncols; j++) { col = rcol[j]; if (gcid[col] >= 0 && (PetscRealPart(rval[j]) > gamg->threshold*Amax_pos[i] || PetscRealPart(-rval[j]) > gamg->threshold*Amax_neg[i])) { row_f = i + fs; row_c = gcid[col]; /* set the values for on-processor ones */ if (PetscRealPart(rval[j]) < 0.) { pij = rval[j]*alpha*invdiag; } else { pij = rval[j]*beta*invdiag; } if (PetscAbsScalar(pij) != 0.) { pvals[idx] = pij; pcols[idx] = row_c; idx++; } } } ierr = MatRestoreRow(gA,i,&ncols,&rcol,&rval);CHKERRQ(ierr); } ierr = MatSetValues(*P,1,&row_f,idx,pcols,pvals,INSERT_VALUES);CHKERRQ(ierr); } } ierr = MatAssemblyBegin(*P, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(*P, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = PetscFree(lsparse);CHKERRQ(ierr); ierr = PetscFree(gsparse);CHKERRQ(ierr); ierr = PetscFree(pcols);CHKERRQ(ierr); ierr = PetscFree(pvals);CHKERRQ(ierr); ierr = PetscFree(Amax_pos);CHKERRQ(ierr); ierr = PetscFree(Amax_neg);CHKERRQ(ierr); ierr = PetscFree(lcid);CHKERRQ(ierr); if (gA) {ierr = PetscFree(gcid);CHKERRQ(ierr);} PetscFunctionReturn(0); }

PetscErrorCode PCGAMGTruncateProlongator_Private(PC pc,Mat *P) { PetscInt j,i,ps,pf,pn,pcs,pcf,pcn,idx,cmax; PetscErrorCode ierr; const PetscScalar *pval; const PetscInt *pcol; PetscScalar *pnval; PetscInt *pncol; PetscInt ncols; Mat Pnew; PetscInt *lsparse,*gsparse; PetscReal pmax_pos,pmax_neg,ptot_pos,ptot_neg,pthresh_pos,pthresh_neg; PC_MG *mg = (PC_MG*)pc->data; PC_GAMG *pc_gamg = (PC_GAMG*)mg->innerctx; PC_GAMG_Classical *cls = (PC_GAMG_Classical*)pc_gamg->subctx; PetscFunctionBegin; /* trim and rescale with reallocation */ ierr = MatGetOwnershipRange(*P,&ps,&pf);CHKERRQ(ierr); ierr = MatGetOwnershipRangeColumn(*P,&pcs,&pcf);CHKERRQ(ierr); pn = pf-ps; pcn = pcf-pcs; ierr = PetscMalloc(sizeof(PetscInt)*pn,&lsparse);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscInt)*pn,&gsparse);CHKERRQ(ierr); /* allocate */ cmax = 0; for (i=ps;i<pf;i++) { lsparse[i-ps] = 0; gsparse[i-ps] = 0; ierr = MatGetRow(*P,i,&ncols,&pcol,&pval);CHKERRQ(ierr); if (ncols > cmax) { cmax = ncols; } pmax_pos = 0.; pmax_neg = 0.; for (j=0;j<ncols;j++) { if (PetscRealPart(pval[j]) > pmax_pos) { pmax_pos = PetscRealPart(pval[j]); } else if (PetscRealPart(pval[j]) < pmax_neg) { pmax_neg = PetscRealPart(pval[j]); } } for (j=0;j<ncols;j++) { if (PetscRealPart(pval[j]) >= pmax_pos*cls->interp_threshold || PetscRealPart(pval[j]) <= pmax_neg*cls->interp_threshold) { if (pcol[j] >= pcs && pcol[j] < pcf) { lsparse[i-ps]++; } else { gsparse[i-ps]++; } } } ierr = MatRestoreRow(*P,i,&ncols,&pcol,&pval);CHKERRQ(ierr); } ierr = PetscMalloc(sizeof(PetscScalar)*cmax,&pnval);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscInt)*cmax,&pncol);CHKERRQ(ierr); ierr = MatCreate(PetscObjectComm((PetscObject)*P),&Pnew);CHKERRQ(ierr); ierr = MatSetType(Pnew, MATAIJ);CHKERRQ(ierr); ierr = MatSetSizes(Pnew,pn,pcn,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(Pnew,0,lsparse);CHKERRQ(ierr); ierr = MatMPIAIJSetPreallocation(Pnew,0,lsparse,0,gsparse);CHKERRQ(ierr); for (i=ps;i<pf;i++) { ierr = MatGetRow(*P,i,&ncols,&pcol,&pval);CHKERRQ(ierr); pmax_pos = 0.; pmax_neg = 0.; for (j=0;j<ncols;j++) { if (PetscRealPart(pval[j]) > pmax_pos) { pmax_pos = PetscRealPart(pval[j]); } else if (PetscRealPart(pval[j]) < pmax_neg) { pmax_neg = PetscRealPart(pval[j]); } } pthresh_pos = 0.; pthresh_neg = 0.; ptot_pos = 0.; ptot_neg = 0.; for (j=0;j<ncols;j++) { if (PetscRealPart(pval[j]) >= cls->interp_threshold*pmax_pos) { pthresh_pos += PetscRealPart(pval[j]); } else if (PetscRealPart(pval[j]) <= cls->interp_threshold*pmax_neg) { pthresh_neg += PetscRealPart(pval[j]); } if (PetscRealPart(pval[j]) > 0.) { ptot_pos += PetscRealPart(pval[j]); } else { ptot_neg += PetscRealPart(pval[j]); } } if (PetscAbsReal(pthresh_pos) > 0.) ptot_pos /= pthresh_pos; if (PetscAbsReal(pthresh_neg) > 0.) ptot_neg /= pthresh_neg; idx=0; for (j=0;j<ncols;j++) { if (PetscRealPart(pval[j]) >= pmax_pos*cls->interp_threshold) { pnval[idx] = ptot_pos*pval[j]; pncol[idx] = pcol[j]; idx++; } else if (PetscRealPart(pval[j]) <= pmax_neg*cls->interp_threshold) { pnval[idx] = ptot_neg*pval[j]; pncol[idx] = pcol[j]; idx++; } } ierr = MatRestoreRow(*P,i,&ncols,&pcol,&pval);CHKERRQ(ierr); ierr = MatSetValues(Pnew,1,&i,idx,pncol,pnval,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(Pnew, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(Pnew, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatDestroy(P);CHKERRQ(ierr); *P = Pnew; ierr = PetscFree(lsparse);CHKERRQ(ierr); ierr = PetscFree(gsparse);CHKERRQ(ierr); ierr = PetscFree(pncol);CHKERRQ(ierr); ierr = PetscFree(pnval);CHKERRQ(ierr); PetscFunctionReturn(0); }

int main(int argc,char **argv) { SNES snes; /* SNES context */ Vec x,r,F,U; /* vectors */ Mat J; /* Jacobian matrix */ MonitorCtx monP; /* monitoring context */ PetscErrorCode ierr; PetscInt its,n = 5,i,maxit,maxf; PetscMPIInt size; PetscScalar h,xp,v,none = -1.0; PetscReal abstol,rtol,stol,norm; PetscInitialize(&argc,&argv,(char*)0,help); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"This is a uniprocessor example only!"); ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr); h = 1.0/(n-1); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create nonlinear solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = SNESCreate(PETSC_COMM_WORLD,&snes);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create vector data structures; set function evaluation routine - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Note that we form 1 vector from scratch and then duplicate as needed. */ ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr); ierr = VecSetSizes(x,PETSC_DECIDE,n);CHKERRQ(ierr); ierr = VecSetFromOptions(x);CHKERRQ(ierr); ierr = VecDuplicate(x,&r);CHKERRQ(ierr); ierr = VecDuplicate(x,&F);CHKERRQ(ierr); ierr = VecDuplicate(x,&U);CHKERRQ(ierr); /* Set function evaluation routine and vector */ ierr = SNESSetFunction(snes,r,FormFunction,(void*)F);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create matrix data structure; set Jacobian evaluation routine - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr); ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr); ierr = MatSetFromOptions(J);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(J,3,NULL);CHKERRQ(ierr); /* Set Jacobian matrix data structure and default Jacobian evaluation routine. User can override with: -snes_fd : default finite differencing approximation of Jacobian -snes_mf : matrix-free Newton-Krylov method with no preconditioning (unless user explicitly sets preconditioner) -snes_mf_operator : form preconditioning matrix as set by the user, but use matrix-free approx for Jacobian-vector products within Newton-Krylov method */ ierr = SNESSetJacobian(snes,J,J,FormJacobian,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Customize nonlinear solver; set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Set an optional user-defined monitoring routine */ ierr = PetscViewerDrawOpen(PETSC_COMM_WORLD,0,0,0,0,400,400,&monP.viewer);CHKERRQ(ierr); ierr = SNESMonitorSet(snes,Monitor,&monP,0);CHKERRQ(ierr); /* Set names for some vectors to facilitate monitoring (optional) */ ierr = PetscObjectSetName((PetscObject)x,"Approximate Solution");CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)U,"Exact Solution");CHKERRQ(ierr); /* Set SNES/KSP/KSP/PC runtime options, e.g., -snes_view -snes_monitor -ksp_type <ksp> -pc_type <pc> */ ierr = SNESSetFromOptions(snes);CHKERRQ(ierr); /* Print parameters used for convergence testing (optional) ... just to demonstrate this routine; this information is also printed with the option -snes_view */ ierr = SNESGetTolerances(snes,&abstol,&rtol,&stol,&maxit,&maxf);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"atol=%g, rtol=%g, stol=%g, maxit=%D, maxf=%D\n",(double)abstol,(double)rtol,(double)stol,maxit,maxf);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize application: Store right-hand-side of PDE and exact solution - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ xp = 0.0; for (i=0; i<n; i++) { v = 6.0*xp + PetscPowScalar(xp+1.e-12,6.0); /* +1.e-12 is to prevent 0^6 */ ierr = VecSetValues(F,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr); v = xp*xp*xp; ierr = VecSetValues(U,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr); xp += h; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Evaluate initial guess; then solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Note: The user should initialize the vector, x, with the initial guess for the nonlinear solver prior to calling SNESSolve(). In particular, to employ an initial guess of zero, the user should explicitly set this vector to zero by calling VecSet(). */ ierr = FormInitialGuess(x);CHKERRQ(ierr); ierr = SNESSolve(snes,NULL,x);CHKERRQ(ierr); ierr = SNESGetIterationNumber(snes,&its);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"number of SNES iterations = %D\n\n",its);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 = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %g, Iterations %D\n",(double)norm,its);CHKERRQ(ierr); /* Free work space. All PETSc objects should be destroyed when they are no longer needed. */ ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&r);CHKERRQ(ierr); ierr = VecDestroy(&U);CHKERRQ(ierr); ierr = VecDestroy(&F);CHKERRQ(ierr); ierr = MatDestroy(&J);CHKERRQ(ierr); ierr = SNESDestroy(&snes);CHKERRQ(ierr); ierr = PetscViewerDestroy(&monP.viewer);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }

int main(int argc,char **argv) { TS ts; /* nonlinear solver */ Vec x; /* solution, residual vectors */ Mat A; /* Jacobian matrix */ PetscInt steps; PetscReal ftime = 0.5; PetscBool monitor = PETSC_FALSE; PetscScalar *x_ptr; PetscMPIInt size; struct _n_User user; PetscErrorCode ierr; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize program - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PetscInitialize(&argc,&argv,NULL,help); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size != 1) SETERRQ(PETSC_COMM_SELF,1,"This is a uniprocessor example only!"); ierr = RegisterMyARK2();CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ user.next_output = 0.0; ierr = PetscOptionsGetBool(NULL,NULL,"-monitor",&monitor,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create necessary matrix and vectors, solve same ODE on every process - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,2,2);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSetUp(A);CHKERRQ(ierr); ierr = MatCreateVecs(A,&x,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr); ierr = TSSetIFunction(ts,NULL,IFunction,&user);CHKERRQ(ierr); ierr = TSSetIJacobian(ts,A,A,IJacobian,&user);CHKERRQ(ierr); ierr = TSSetDuration(ts,PETSC_DEFAULT,ftime);CHKERRQ(ierr); if (monitor) { ierr = TSMonitorSet(ts,Monitor,&user,NULL);CHKERRQ(ierr); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = VecGetArray(x,&x_ptr);CHKERRQ(ierr); x_ptr[0] = -2; x_ptr[1] = -2.355301397608119909925287735864250951918; ierr = VecRestoreArray(x,&x_ptr);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,0.0,.001);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetFromOptions(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSolve(ts,x);CHKERRQ(ierr); ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr); ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"steps %D, ftime %g\n",steps,(double)ftime);CHKERRQ(ierr); ierr = VecView(x,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = PetscFinalize(); PetscFunctionReturn(0); }

int main(int argc,char **args) { Mat C; PetscMPIInt rank,size; PetscInt i,m = 5,N,start,end,M,its; PetscScalar val,Ke[16],r[4]; PetscReal x,y,h,norm; PetscErrorCode ierr; PetscInt idx[4],count,*rows; Vec u,ustar,b; KSP ksp; PetscInitialize(&argc,&args,(char *)0,help); ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_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); start = rank*(M/size) + ((M%size) < rank ? (M%size) : rank); end = start + M/size + ((M%size) > rank); /* Assemble matrix */ ierr = FormElementStiffness(h*h,Ke); /* element stiffness for Laplacian */ for (i=start; i<end; i++) { /* location of lower left corner of element */ x = h*(i % m); y = h*(i/m); /* 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 right-hand-side and solution vectors */ ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr); ierr = VecSetSizes(u,PETSC_DECIDE,N);CHKERRQ(ierr); ierr = VecSetFromOptions(u);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)u,"Approx. Solution");CHKERRQ(ierr); ierr = VecDuplicate(u,&b);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)b,"Right hand side");CHKERRQ(ierr); ierr = VecDuplicate(b,&ustar);CHKERRQ(ierr); ierr = VecSet(u,0.0);CHKERRQ(ierr); ierr = VecSet(b,0.0);CHKERRQ(ierr); /* Assemble right-hand-side vector */ for (i=start; i<end; i++) { /* location of lower left corner of element */ x = h*(i % m); y = h*(i/m); /* 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 = FormElementRhs(x,y,h*h,r);CHKERRQ(ierr); ierr = VecSetValues(b,4,idx,r,ADD_VALUES);CHKERRQ(ierr); } ierr = VecAssemblyBegin(b);CHKERRQ(ierr); ierr = VecAssemblyEnd(b);CHKERRQ(ierr); /* Modify matrix and right-hand-side for Dirichlet boundary conditions */ ierr = PetscMalloc(4*m*sizeof(PetscInt),&rows);CHKERRQ(ierr); for (i=0; i<m+1; i++) { rows[i] = i; /* bottom */ rows[3*m - 1 +i] = m*(m+1) + i; /* top */ } count = m+1; /* left side */ for (i=m+1; i<m*(m+1); i+= m+1) { rows[count++] = i; } count = 2*m; /* left side */ for (i=2*m+1; i<m*(m+1); i+= m+1) { rows[count++] = i; } for (i=0; i<4*m; i++) { x = h*(rows[i] % (m+1)); y = h*(rows[i]/(m+1)); val = y; ierr = VecSetValues(u,1,&rows[i],&val,INSERT_VALUES);CHKERRQ(ierr); ierr = VecSetValues(b,1,&rows[i],&val,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatZeroRows(C,4*m,rows,1.0);CHKERRQ(ierr); ierr = PetscFree(rows);CHKERRQ(ierr); ierr = VecAssemblyBegin(u);CHKERRQ(ierr); ierr = VecAssemblyEnd(u);CHKERRQ(ierr); ierr = VecAssemblyBegin(b);CHKERRQ(ierr); ierr = VecAssemblyEnd(b);CHKERRQ(ierr); { Mat A; ierr = MatConvert(C,MATSAME,MAT_INITIAL_MATRIX,&A);CHKERRQ(ierr); ierr = MatDestroy(C);CHKERRQ(ierr); ierr = MatConvert(A,MATSAME,MAT_INITIAL_MATRIX,&C);CHKERRQ(ierr); ierr = MatDestroy(A);CHKERRQ(ierr); } /* Solve linear system */ ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr); ierr = KSPSetOperators(ksp,C,C,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); ierr = KSPSetInitialGuessNonzero(ksp,PETSC_TRUE);CHKERRQ(ierr); ierr = KSPSolve(ksp,b,u);CHKERRQ(ierr); /* Check error */ ierr = VecGetOwnershipRange(ustar,&start,&end);CHKERRQ(ierr); for (i=start; i<end; i++) { x = h*(i % (m+1)); y = h*(i/(m+1)); val = y; ierr = VecSetValues(ustar,1,&i,&val,INSERT_VALUES);CHKERRQ(ierr); } ierr = VecAssemblyBegin(ustar);CHKERRQ(ierr); ierr = VecAssemblyEnd(ustar);CHKERRQ(ierr); ierr = VecAXPY(u,-1.0,ustar);CHKERRQ(ierr); ierr = VecNorm(u,NORM_2,&norm);CHKERRQ(ierr); ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %A Iterations %D\n",norm*h,its);CHKERRQ(ierr); /* Free work space */ ierr = KSPDestroy(ksp);CHKERRQ(ierr); ierr = VecDestroy(ustar);CHKERRQ(ierr); ierr = VecDestroy(u);CHKERRQ(ierr); ierr = VecDestroy(b);CHKERRQ(ierr); ierr = MatDestroy(C);CHKERRQ(ierr); ierr = PetscFinalize();CHKERRQ(ierr); return 0; }

EXTERN_C_END /*MC MATSOLVERUMFPACK = "umfpack" - A matrix type providing direct solvers (LU) for sequential matrices via the external package UMFPACK. ./configure --download-umfpack to install PETSc to use UMFPACK Consult UMFPACK documentation for more information about the Control parameters which correspond to the options database keys below. Options Database Keys: + -mat_umfpack_prl - UMFPACK print level: Control[UMFPACK_PRL] . -mat_umfpack_strategy <AUTO> - (choose one of) AUTO UNSYMMETRIC SYMMETRIC 2BY2 . -mat_umfpack_dense_col <alpha_c> - UMFPACK dense column threshold: Control[UMFPACK_DENSE_COL] . -mat_umfpack_dense_row <0.2> - Control[UMFPACK_DENSE_ROW] . -mat_umfpack_amd_dense <10> - Control[UMFPACK_AMD_DENSE] . -mat_umfpack_block_size <bs> - UMFPACK block size for BLAS-Level 3 calls: Control[UMFPACK_BLOCK_SIZE] . -mat_umfpack_2by2_tolerance <0.01> - Control[UMFPACK_2BY2_TOLERANCE] . -mat_umfpack_fixq <0> - Control[UMFPACK_FIXQ] . -mat_umfpack_aggressive <1> - Control[UMFPACK_AGGRESSIVE] . -mat_umfpack_pivot_tolerance <delta> - UMFPACK partial pivot tolerance: Control[UMFPACK_PIVOT_TOLERANCE] . -mat_umfpack_sym_pivot_tolerance <0.001> - Control[UMFPACK_SYM_PIVOT_TOLERANCE] . -mat_umfpack_scale <NONE> - (choose one of) NONE SUM MAX . -mat_umfpack_alloc_init <delta> - UMFPACK factorized matrix allocation modifier: Control[UMFPACK_ALLOC_INIT] . -mat_umfpack_droptol <0> - Control[UMFPACK_DROPTOL] - -mat_umfpack_irstep <maxit> - UMFPACK maximum number of iterative refinement steps: Control[UMFPACK_IRSTEP] Level: beginner .seealso: PCLU, MATSOLVERSUPERLU, MATSOLVERMUMPS, MATSOLVERSPOOLES, PCFactorSetMatSolverPackage(), MatSolverPackage M*/ EXTERN_C_BEGIN #undef __FUNCT__ #define __FUNCT__ "MatGetFactor_seqaij_umfpack" PetscErrorCode MatGetFactor_seqaij_umfpack(Mat A,MatFactorType ftype,Mat *F) { Mat B; Mat_UMFPACK *lu; PetscErrorCode ierr; PetscInt m=A->rmap->n,n=A->cmap->n,idx; const char *strategy[]={"AUTO","UNSYMMETRIC","SYMMETRIC"}, *scale[]={"NONE","SUM","MAX"}; PetscBool flg; PetscFunctionBegin; /* Create the factorization matrix F */ ierr = MatCreate(((PetscObject)A)->comm,&B);CHKERRQ(ierr); ierr = MatSetSizes(B,PETSC_DECIDE,PETSC_DECIDE,m,n);CHKERRQ(ierr); ierr = MatSetType(B,((PetscObject)A)->type_name);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(B,0,PETSC_NULL);CHKERRQ(ierr); ierr = PetscNewLog(B,Mat_UMFPACK,&lu);CHKERRQ(ierr); B->spptr = lu; B->ops->lufactorsymbolic = MatLUFactorSymbolic_UMFPACK; B->ops->destroy = MatDestroy_UMFPACK; B->ops->view = MatView_UMFPACK; ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatFactorGetSolverPackage_C","MatFactorGetSolverPackage_seqaij_umfpack",MatFactorGetSolverPackage_seqaij_umfpack);CHKERRQ(ierr); B->factortype = MAT_FACTOR_LU; B->assembled = PETSC_TRUE; /* required by -ksp_view */ B->preallocated = PETSC_TRUE; /* initializations */ /* ------------------------------------------------*/ /* get the default control parameters */ umfpack_UMF_defaults(lu->Control); lu->perm_c = PETSC_NULL; /* use defaul UMFPACK col permutation */ lu->Control[UMFPACK_IRSTEP] = 0; /* max num of iterative refinement steps to attempt */ ierr = PetscOptionsBegin(((PetscObject)A)->comm,((PetscObject)A)->prefix,"UMFPACK Options","Mat");CHKERRQ(ierr); /* Control parameters used by reporting routiones */ ierr = PetscOptionsReal("-mat_umfpack_prl","Control[UMFPACK_PRL]","None",lu->Control[UMFPACK_PRL],&lu->Control[UMFPACK_PRL],PETSC_NULL);CHKERRQ(ierr); /* Control parameters for symbolic factorization */ ierr = PetscOptionsEList("-mat_umfpack_strategy","ordering and pivoting strategy","None",strategy,3,strategy[0],&idx,&flg);CHKERRQ(ierr); if (flg) { switch (idx){ case 0: lu->Control[UMFPACK_STRATEGY] = UMFPACK_STRATEGY_AUTO; break; case 1: lu->Control[UMFPACK_STRATEGY] = UMFPACK_STRATEGY_UNSYMMETRIC; break; case 2: lu->Control[UMFPACK_STRATEGY] = UMFPACK_STRATEGY_SYMMETRIC; break; } } ierr = PetscOptionsEList("-mat_umfpack_ordering","Internal ordering method","None",UmfpackOrderingTypes,sizeof UmfpackOrderingTypes/sizeof UmfpackOrderingTypes[0],UmfpackOrderingTypes[(int)lu->Control[UMFPACK_ORDERING]],&idx,&flg);CHKERRQ(ierr); if (flg) lu->Control[UMFPACK_ORDERING] = (int)idx; ierr = PetscOptionsReal("-mat_umfpack_dense_col","Control[UMFPACK_DENSE_COL]","None",lu->Control[UMFPACK_DENSE_COL],&lu->Control[UMFPACK_DENSE_COL],PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-mat_umfpack_dense_row","Control[UMFPACK_DENSE_ROW]","None",lu->Control[UMFPACK_DENSE_ROW],&lu->Control[UMFPACK_DENSE_ROW],PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-mat_umfpack_amd_dense","Control[UMFPACK_AMD_DENSE]","None",lu->Control[UMFPACK_AMD_DENSE],&lu->Control[UMFPACK_AMD_DENSE],PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-mat_umfpack_block_size","Control[UMFPACK_BLOCK_SIZE]","None",lu->Control[UMFPACK_BLOCK_SIZE],&lu->Control[UMFPACK_BLOCK_SIZE],PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-mat_umfpack_fixq","Control[UMFPACK_FIXQ]","None",lu->Control[UMFPACK_FIXQ],&lu->Control[UMFPACK_FIXQ],PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-mat_umfpack_aggressive","Control[UMFPACK_AGGRESSIVE]","None",lu->Control[UMFPACK_AGGRESSIVE],&lu->Control[UMFPACK_AGGRESSIVE],PETSC_NULL);CHKERRQ(ierr); /* Control parameters used by numeric factorization */ ierr = PetscOptionsReal("-mat_umfpack_pivot_tolerance","Control[UMFPACK_PIVOT_TOLERANCE]","None",lu->Control[UMFPACK_PIVOT_TOLERANCE],&lu->Control[UMFPACK_PIVOT_TOLERANCE],PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-mat_umfpack_sym_pivot_tolerance","Control[UMFPACK_SYM_PIVOT_TOLERANCE]","None",lu->Control[UMFPACK_SYM_PIVOT_TOLERANCE],&lu->Control[UMFPACK_SYM_PIVOT_TOLERANCE],PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsEList("-mat_umfpack_scale","Control[UMFPACK_SCALE]","None",scale,3,scale[0],&idx,&flg);CHKERRQ(ierr); if (flg) { switch (idx){ case 0: lu->Control[UMFPACK_SCALE] = UMFPACK_SCALE_NONE; break; case 1: lu->Control[UMFPACK_SCALE] = UMFPACK_SCALE_SUM; break; case 2: lu->Control[UMFPACK_SCALE] = UMFPACK_SCALE_MAX; break; } } ierr = PetscOptionsReal("-mat_umfpack_alloc_init","Control[UMFPACK_ALLOC_INIT]","None",lu->Control[UMFPACK_ALLOC_INIT],&lu->Control[UMFPACK_ALLOC_INIT],PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-mat_umfpack_front_alloc_init","Control[UMFPACK_FRONT_ALLOC_INIT]","None",lu->Control[UMFPACK_FRONT_ALLOC_INIT],&lu->Control[UMFPACK_ALLOC_INIT],PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-mat_umfpack_droptol","Control[UMFPACK_DROPTOL]","None",lu->Control[UMFPACK_DROPTOL],&lu->Control[UMFPACK_DROPTOL],PETSC_NULL);CHKERRQ(ierr); /* Control parameters used by solve */ ierr = PetscOptionsReal("-mat_umfpack_irstep","Control[UMFPACK_IRSTEP]","None",lu->Control[UMFPACK_IRSTEP],&lu->Control[UMFPACK_IRSTEP],PETSC_NULL);CHKERRQ(ierr); /* use Petsc mat ordering (note: size is for the transpose, and PETSc r = Umfpack perm_c) */ ierr = PetscOptionsHasName(PETSC_NULL,"-pc_factor_mat_ordering_type",&lu->PetscMatOrdering);CHKERRQ(ierr); PetscOptionsEnd(); *F = B; PetscFunctionReturn(0); }

int main(int argc,char **argv) { Mat pA,P,aijP; PetscScalar pa[]={1.,-1.,0.,0.,1.,-1.,0.,0.,1.}; PetscInt pij[]={0,1,2}; PetscInt aij[3][3]={{0,1,2},{3,4,5},{6,7,8}}; Mat A,mC,C; PetscScalar one=1.; PetscErrorCode ierr; PetscInitialize(&argc,&argv,(char *)0,help); /* Create MAIJ matrix, P */ ierr = MatCreate(PETSC_COMM_SELF,&pA);CHKERRQ(ierr); ierr = MatSetSizes(pA,3,3,3,3);CHKERRQ(ierr); ierr = MatSetType(pA,MATSEQAIJ);CHKERRQ(ierr); ierr = MatSetOption(pA,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr); ierr = MatSetValues(pA,3,pij,3,pij,pa,ADD_VALUES);CHKERRQ(ierr); ierr = MatAssemblyBegin(pA,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(pA,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatCreateMAIJ(pA,3,&P);CHKERRQ(ierr); ierr = MatDestroy(pA); /* Create AIJ equivalent matrix, aijP, for comparison testing */ ierr = MatConvert(P,MATSEQAIJ,MAT_INITIAL_MATRIX,&aijP); /* Create AIJ matrix, A */ ierr = MatCreate(PETSC_COMM_SELF,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,9,9,9,9);CHKERRQ(ierr); ierr = MatSetType(A,MATSEQAIJ);CHKERRQ(ierr); ierr = MatSetOption(A,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr); ierr = MatSetValues(A,3,aij[0],3,aij[0],pa,ADD_VALUES);CHKERRQ(ierr); ierr = MatSetValues(A,3,aij[1],3,aij[1],pa,ADD_VALUES);CHKERRQ(ierr); ierr = MatSetValues(A,3,aij[2],3,aij[2],pa,ADD_VALUES);CHKERRQ(ierr); {int i; for (i=0;i<9;i++) { ierr = MatSetValue(A,i,i,one,ADD_VALUES);CHKERRQ(ierr); } } ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* Perform SeqAIJ_SeqMAIJ PtAP */ ierr = MatPtAP(A,P,MAT_INITIAL_MATRIX,1.,&mC);CHKERRQ(ierr); ierr = MatView(mC,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); /* Perform SeqAIJ_SeqAIJ PtAP for comparison testing */ ierr = MatPtAP(A,aijP,MAT_INITIAL_MATRIX,1.,&C);CHKERRQ(ierr); ierr = MatView(C,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); /* Perform diff of two matrices */ ierr = MatAXPY(C,-1.0,mC,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); /* Note: We should be able to use SAME_NONZERO_PATTERN on the line above, */ /* but don't because this flag doesn't assist testing. */ ierr = MatView(C,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); /* Cleanup */ ierr = MatDestroy(P); ierr = MatDestroy(aijP); ierr = MatDestroy(A); ierr = MatDestroy(C); ierr = MatDestroy(mC); PetscFinalize(); return(0); }

PetscErrorCode MatISGetMPIXAIJ_IS(Mat mat, MatReuse reuse, Mat *M) { Mat_IS *matis = (Mat_IS*)(mat->data); /* info on mat */ /* ISLocalToGlobalMapping rmapping,cmapping; */ PetscInt bs,rows,cols; PetscInt lrows,lcols; PetscInt local_rows,local_cols; PetscBool isdense,issbaij,issbaij_red; /* values insertion */ PetscScalar *array; PetscInt *local_indices,*global_indices; /* work */ PetscInt i,j,index_row; PetscErrorCode ierr; PetscFunctionBegin; /* MISSING CHECKS - rectangular case not covered (it is not allowed by MATIS) */ /* get info from mat */ /* ierr = MatGetLocalToGlobalMapping(mat,&rmapping,&cmapping);CHKERRQ(ierr); */ ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr); ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr); ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQDENSE,&isdense);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr); /* work */ ierr = PetscMalloc1(local_rows,&local_indices);CHKERRQ(ierr); for (i=0;i<local_rows;i++) local_indices[i]=i; /* map indices of local mat to global values */ ierr = PetscMalloc(PetscMax(local_cols,local_rows)*sizeof(*global_indices),&global_indices);CHKERRQ(ierr); /* ierr = ISLocalToGlobalMappingApply(rmapping,local_rows,local_indices,global_indices);CHKERRQ(ierr); */ ierr = ISLocalToGlobalMappingApply(matis->mapping,local_rows,local_indices,global_indices);CHKERRQ(ierr); if (issbaij) { ierr = MatGetRowUpperTriangular(matis->A);CHKERRQ(ierr); } if (reuse == MAT_INITIAL_MATRIX) { Mat new_mat; MatType new_mat_type; Vec vec_dnz,vec_onz; PetscScalar *my_dnz,*my_onz; PetscInt *dnz,*onz,*mat_ranges,*row_ownership; PetscInt index_col,owner; PetscMPIInt nsubdomains; /* determining new matrix type */ ierr = MPI_Allreduce(&issbaij,&issbaij_red,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr); if (issbaij_red) { new_mat_type = MATSBAIJ; } else { if (bs>1) { new_mat_type = MATBAIJ; } else { new_mat_type = MATAIJ; } } ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr); ierr = MatCreate(PetscObjectComm((PetscObject)mat),&new_mat);CHKERRQ(ierr); ierr = MatSetSizes(new_mat,PETSC_DECIDE,PETSC_DECIDE,rows,cols);CHKERRQ(ierr); ierr = MatSetBlockSize(new_mat,bs);CHKERRQ(ierr); ierr = MatSetType(new_mat,new_mat_type);CHKERRQ(ierr); ierr = MatSetUp(new_mat);CHKERRQ(ierr); ierr = MatGetLocalSize(new_mat,&lrows,&lcols);CHKERRQ(ierr); /* preallocation */ ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)new_mat),lrows,lcols,dnz,onz);CHKERRQ(ierr); /* Some vectors are needed to sum up properly on shared interface dofs. Preallocation macros cannot do the job. Note that preallocation is not exact, since it overestimates nonzeros */ ierr = MatCreateVecs(new_mat,NULL,&vec_dnz);CHKERRQ(ierr); /* ierr = VecSetLocalToGlobalMapping(vec_dnz,rmapping);CHKERRQ(ierr); */ ierr = VecSetLocalToGlobalMapping(vec_dnz,matis->mapping);CHKERRQ(ierr); ierr = VecDuplicate(vec_dnz,&vec_onz);CHKERRQ(ierr); /* All processes need to compute entire row ownership */ ierr = PetscMalloc1(rows,&row_ownership);CHKERRQ(ierr); ierr = MatGetOwnershipRanges(new_mat,(const PetscInt**)&mat_ranges);CHKERRQ(ierr); for (i=0;i<nsubdomains;i++) { for (j=mat_ranges[i];j<mat_ranges[i+1];j++) { row_ownership[j]=i; } } /* my_dnz and my_onz contains exact contribution to preallocation from each local mat then, they will be summed up properly. This way, preallocation is always sufficient */ ierr = PetscMalloc1(local_rows,&my_dnz);CHKERRQ(ierr); ierr = PetscMalloc1(local_rows,&my_onz);CHKERRQ(ierr); ierr = PetscMemzero(my_dnz,local_rows*sizeof(*my_dnz));CHKERRQ(ierr); ierr = PetscMemzero(my_onz,local_rows*sizeof(*my_onz));CHKERRQ(ierr); /* preallocation as a MATAIJ */ if (isdense) { /* special case for dense local matrices */ for (i=0;i<local_rows;i++) { index_row = global_indices[i]; for (j=i;j<local_rows;j++) { owner = row_ownership[index_row]; index_col = global_indices[j]; if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */ my_dnz[i] += 1.0; } else { /* offdiag block */ my_onz[i] += 1.0; } /* same as before, interchanging rows and cols */ if (i != j) { owner = row_ownership[index_col]; if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) { my_dnz[j] += 1.0; } else { my_onz[j] += 1.0; } } } } } else { for (i=0;i<local_rows;i++) { PetscInt ncols; const PetscInt *cols; index_row = global_indices[i]; ierr = MatGetRow(matis->A,i,&ncols,&cols,NULL);CHKERRQ(ierr); for (j=0;j<ncols;j++) { owner = row_ownership[index_row]; index_col = global_indices[cols[j]]; if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */ my_dnz[i] += 1.0; } else { /* offdiag block */ my_onz[i] += 1.0; } /* same as before, interchanging rows and cols */ if (issbaij) { owner = row_ownership[index_col]; if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) { my_dnz[j] += 1.0; } else { my_onz[j] += 1.0; } } } ierr = MatRestoreRow(matis->A,i,&ncols,&cols,NULL);CHKERRQ(ierr); } } ierr = VecSet(vec_dnz,0.0);CHKERRQ(ierr); ierr = VecSet(vec_onz,0.0);CHKERRQ(ierr); if (local_rows) { /* multilevel guard */ ierr = VecSetValuesLocal(vec_dnz,local_rows,local_indices,my_dnz,ADD_VALUES);CHKERRQ(ierr); ierr = VecSetValuesLocal(vec_onz,local_rows,local_indices,my_onz,ADD_VALUES);CHKERRQ(ierr); } ierr = VecAssemblyBegin(vec_dnz);CHKERRQ(ierr); ierr = VecAssemblyBegin(vec_onz);CHKERRQ(ierr); ierr = VecAssemblyEnd(vec_dnz);CHKERRQ(ierr); ierr = VecAssemblyEnd(vec_onz);CHKERRQ(ierr); ierr = PetscFree(my_dnz);CHKERRQ(ierr); ierr = PetscFree(my_onz);CHKERRQ(ierr); ierr = PetscFree(row_ownership);CHKERRQ(ierr); /* set computed preallocation in dnz and onz */ ierr = VecGetArray(vec_dnz,&array);CHKERRQ(ierr); for (i=0; i<lrows; i++) dnz[i] = (PetscInt)PetscRealPart(array[i]); ierr = VecRestoreArray(vec_dnz,&array);CHKERRQ(ierr); ierr = VecGetArray(vec_onz,&array);CHKERRQ(ierr); for (i=0;i<lrows;i++) onz[i] = (PetscInt)PetscRealPart(array[i]); ierr = VecRestoreArray(vec_onz,&array);CHKERRQ(ierr); ierr = VecDestroy(&vec_dnz);CHKERRQ(ierr); ierr = VecDestroy(&vec_onz);CHKERRQ(ierr); /* Resize preallocation if overestimated */ for (i=0;i<lrows;i++) { dnz[i] = PetscMin(dnz[i],lcols); onz[i] = PetscMin(onz[i],cols-lcols); } /* set preallocation */ ierr = MatMPIAIJSetPreallocation(new_mat,0,dnz,0,onz);CHKERRQ(ierr); for (i=0;i<lrows/bs;i++) { dnz[i] = dnz[i*bs]/bs; onz[i] = onz[i*bs]/bs; } ierr = MatMPIBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr); for (i=0;i<lrows/bs;i++) { dnz[i] = dnz[i]-i; } ierr = MatMPISBAIJSetPreallocation(new_mat,bs,0,dnz,0,onz);CHKERRQ(ierr); ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr); *M = new_mat; } else { PetscInt mbs,mrows,mcols; /* some checks */ ierr = MatGetBlockSize(*M,&mbs);CHKERRQ(ierr); ierr = MatGetSize(*M,&mrows,&mcols);CHKERRQ(ierr); if (mrows != rows) { SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of rows (%d != %d)",rows,mrows); } if (mrows != rows) { SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of cols (%d != %d)",cols,mcols); } if (mbs != bs) { SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong block size (%d != %d)",bs,mbs); } ierr = MatZeroEntries(*M);CHKERRQ(ierr); } /* set local to global mappings */ /* ierr = MatSetLocalToGlobalMapping(*M,rmapping,cmapping);CHKERRQ(ierr); */ /* Set values */ if (isdense) { /* special case for dense local matrices */ ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); ierr = MatDenseGetArray(matis->A,&array);CHKERRQ(ierr); ierr = MatSetValues(*M,local_rows,global_indices,local_cols,global_indices,array,ADD_VALUES);CHKERRQ(ierr); ierr = MatDenseRestoreArray(matis->A,&array);CHKERRQ(ierr); ierr = PetscFree(local_indices);CHKERRQ(ierr); ierr = PetscFree(global_indices);CHKERRQ(ierr); } else { /* very basic values insertion for all other matrix types */ ierr = PetscFree(local_indices);CHKERRQ(ierr); for (i=0;i<local_rows;i++) { ierr = MatGetRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr); /* ierr = MatSetValuesLocal(*M,1,&i,j,local_indices,array,ADD_VALUES);CHKERRQ(ierr); */ ierr = ISLocalToGlobalMappingApply(matis->mapping,j,local_indices,global_indices);CHKERRQ(ierr); ierr = ISLocalToGlobalMappingApply(matis->mapping,1,&i,&index_row);CHKERRQ(ierr); ierr = MatSetValues(*M,1,&index_row,j,global_indices,array,ADD_VALUES);CHKERRQ(ierr); ierr = MatRestoreRow(matis->A,i,&j,(const PetscInt**)&local_indices,(const PetscScalar**)&array);CHKERRQ(ierr); } ierr = PetscFree(global_indices);CHKERRQ(ierr); } ierr = MatAssemblyBegin(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); if (isdense) { ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr); } if (issbaij) { ierr = MatRestoreRowUpperTriangular(matis->A);CHKERRQ(ierr); } PetscFunctionReturn(0); }

PetscErrorCode PCGAMGProlongator_Classical_Standard(PC pc, const Mat A, const Mat G, PetscCoarsenData *agg_lists,Mat *P) { PetscErrorCode ierr; Mat *lA; Vec lv,v,cv; PetscScalar *lcid; IS lis; PetscInt fs,fe,cs,ce,nl,i,j,k,li,lni,ci; VecScatter lscat; PetscInt fn,cn,cid,c_indx; PetscBool iscoarse; PetscScalar c_scalar; const PetscScalar *vcol; const PetscInt *icol; const PetscInt *gidx; PetscInt ncols; PetscInt *lsparse,*gsparse; MatType mtype; PetscInt maxcols; PetscReal diag,jdiag,jwttotal; PetscScalar *pvcol,vi; PetscInt *picol; PetscInt pncols; PetscScalar *pcontrib,pentry,pjentry; /* PC_MG *mg = (PC_MG*)pc->data; */ /* PC_GAMG *gamg = (PC_GAMG*)mg->innerctx; */ PetscFunctionBegin; ierr = MatGetOwnershipRange(A,&fs,&fe);CHKERRQ(ierr); fn = fe-fs; ierr = MatGetVecs(A,NULL,&v);CHKERRQ(ierr); ierr = ISCreateStride(PETSC_COMM_SELF,fe-fs,fs,1,&lis);CHKERRQ(ierr); /* increase the overlap by two to get neighbors of neighbors */ ierr = MatIncreaseOverlap(A,1,&lis,2);CHKERRQ(ierr); ierr = ISSort(lis);CHKERRQ(ierr); /* get the local part of A */ ierr = MatGetSubMatrices(A,1,&lis,&lis,MAT_INITIAL_MATRIX,&lA);CHKERRQ(ierr); /* build the scatter out of it */ ierr = ISGetLocalSize(lis,&nl);CHKERRQ(ierr); ierr = VecCreateSeq(PETSC_COMM_SELF,nl,&lv);CHKERRQ(ierr); ierr = VecScatterCreate(v,lis,lv,NULL,&lscat);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscInt)*fn,&lsparse);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscInt)*fn,&gsparse);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscScalar)*nl,&pcontrib);CHKERRQ(ierr); /* create coarse vector */ cn = 0; for (i=0;i<fn;i++) { ierr = PetscCDEmptyAt(agg_lists,i,&iscoarse);CHKERRQ(ierr); if (!iscoarse) { cn++; } } ierr = VecCreateMPI(PetscObjectComm((PetscObject)A),cn,PETSC_DECIDE,&cv);CHKERRQ(ierr); ierr = VecGetOwnershipRange(cv,&cs,&ce);CHKERRQ(ierr); cn = 0; for (i=0;i<fn;i++) { ierr = PetscCDEmptyAt(agg_lists,i,&iscoarse); CHKERRQ(ierr); if (!iscoarse) { cid = cs+cn; cn++; } else { cid = -1; } *(PetscInt*)&c_scalar = cid; c_indx = fs+i; ierr = VecSetValues(v,1,&c_indx,&c_scalar,INSERT_VALUES);CHKERRQ(ierr); } ierr = VecScatterBegin(lscat,v,lv,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); ierr = VecScatterEnd(lscat,v,lv,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); /* count to preallocate the prolongator */ ierr = ISGetIndices(lis,&gidx);CHKERRQ(ierr); ierr = VecGetArray(lv,&lcid);CHKERRQ(ierr); maxcols = 0; /* count the number of unique contributing coarse cells for each fine */ for (i=0;i<nl;i++) { pcontrib[i] = 0.; ierr = MatGetRow(lA[0],i,&ncols,&icol,NULL);CHKERRQ(ierr); if (gidx[i] >= fs && gidx[i] < fe) { li = gidx[i] - fs; lsparse[li] = 0; gsparse[li] = 0; cid = *(PetscInt*)&(lcid[i]); if (cid >= 0) { lsparse[li] = 1; } else { for (j=0;j<ncols;j++) { if (*(PetscInt*)&(lcid[icol[j]]) >= 0) { pcontrib[icol[j]] = 1.; } else { ci = icol[j]; ierr = MatRestoreRow(lA[0],i,&ncols,&icol,NULL);CHKERRQ(ierr); ierr = MatGetRow(lA[0],ci,&ncols,&icol,NULL);CHKERRQ(ierr); for (k=0;k<ncols;k++) { if (*(PetscInt*)&(lcid[icol[k]]) >= 0) { pcontrib[icol[k]] = 1.; } } ierr = MatRestoreRow(lA[0],ci,&ncols,&icol,NULL);CHKERRQ(ierr); ierr = MatGetRow(lA[0],i,&ncols,&icol,NULL);CHKERRQ(ierr); } } for (j=0;j<ncols;j++) { if (*(PetscInt*)&(lcid[icol[j]]) >= 0 && pcontrib[icol[j]] != 0.) { lni = *(PetscInt*)&(lcid[icol[j]]); if (lni >= cs && lni < ce) { lsparse[li]++; } else { gsparse[li]++; } pcontrib[icol[j]] = 0.; } else { ci = icol[j]; ierr = MatRestoreRow(lA[0],i,&ncols,&icol,NULL);CHKERRQ(ierr); ierr = MatGetRow(lA[0],ci,&ncols,&icol,NULL);CHKERRQ(ierr); for (k=0;k<ncols;k++) { if (*(PetscInt*)&(lcid[icol[k]]) >= 0 && pcontrib[icol[k]] != 0.) { lni = *(PetscInt*)&(lcid[icol[k]]); if (lni >= cs && lni < ce) { lsparse[li]++; } else { gsparse[li]++; } pcontrib[icol[k]] = 0.; } } ierr = MatRestoreRow(lA[0],ci,&ncols,&icol,NULL);CHKERRQ(ierr); ierr = MatGetRow(lA[0],i,&ncols,&icol,NULL);CHKERRQ(ierr); } } } if (lsparse[li] + gsparse[li] > maxcols) maxcols = lsparse[li]+gsparse[li]; } ierr = MatRestoreRow(lA[0],i,&ncols,&icol,&vcol);CHKERRQ(ierr); } ierr = PetscMalloc(sizeof(PetscInt)*maxcols,&picol);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscScalar)*maxcols,&pvcol);CHKERRQ(ierr); ierr = MatCreate(PetscObjectComm((PetscObject)A),P);CHKERRQ(ierr); ierr = MatGetType(A,&mtype);CHKERRQ(ierr); ierr = MatSetType(*P,mtype);CHKERRQ(ierr); ierr = MatSetSizes(*P,fn,cn,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr); ierr = MatMPIAIJSetPreallocation(*P,0,lsparse,0,gsparse);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(*P,0,lsparse);CHKERRQ(ierr); for (i=0;i<nl;i++) { diag = 0.; if (gidx[i] >= fs && gidx[i] < fe) { li = gidx[i] - fs; pncols=0; cid = *(PetscInt*)&(lcid[i]); if (cid >= 0) { pncols = 1; picol[0] = cid; pvcol[0] = 1.; } else { ierr = MatGetRow(lA[0],i,&ncols,&icol,&vcol);CHKERRQ(ierr); for (j=0;j<ncols;j++) { pentry = vcol[j]; if (*(PetscInt*)&(lcid[icol[j]]) >= 0) { /* coarse neighbor */ pcontrib[icol[j]] += pentry; } else if (icol[j] != i) { /* the neighbor is a strongly connected fine node */ ci = icol[j]; vi = vcol[j]; ierr = MatRestoreRow(lA[0],i,&ncols,&icol,&vcol);CHKERRQ(ierr); ierr = MatGetRow(lA[0],ci,&ncols,&icol,&vcol);CHKERRQ(ierr); jwttotal=0.; jdiag = 0.; for (k=0;k<ncols;k++) { if (ci == icol[k]) { jdiag = PetscRealPart(vcol[k]); } } for (k=0;k<ncols;k++) { if (*(PetscInt*)&(lcid[icol[k]]) >= 0 && jdiag*PetscRealPart(vcol[k]) < 0.) { pjentry = vcol[k]; jwttotal += PetscRealPart(pjentry); } } if (jwttotal != 0.) { jwttotal = PetscRealPart(vi)/jwttotal; for (k=0;k<ncols;k++) { if (*(PetscInt*)&(lcid[icol[k]]) >= 0 && jdiag*PetscRealPart(vcol[k]) < 0.) { pjentry = vcol[k]*jwttotal; pcontrib[icol[k]] += pjentry; } } } else { diag += PetscRealPart(vi); } ierr = MatRestoreRow(lA[0],ci,&ncols,&icol,&vcol);CHKERRQ(ierr); ierr = MatGetRow(lA[0],i,&ncols,&icol,&vcol);CHKERRQ(ierr); } else { diag += PetscRealPart(vcol[j]); } } if (diag != 0.) { diag = 1./diag; for (j=0;j<ncols;j++) { if (*(PetscInt*)&(lcid[icol[j]]) >= 0 && pcontrib[icol[j]] != 0.) { /* the neighbor is a coarse node */ if (PetscAbsScalar(pcontrib[icol[j]]) > 0.0) { lni = *(PetscInt*)&(lcid[icol[j]]); pvcol[pncols] = -pcontrib[icol[j]]*diag; picol[pncols] = lni; pncols++; } pcontrib[icol[j]] = 0.; } else { /* the neighbor is a strongly connected fine node */ ci = icol[j]; ierr = MatRestoreRow(lA[0],i,&ncols,&icol,&vcol);CHKERRQ(ierr); ierr = MatGetRow(lA[0],ci,&ncols,&icol,&vcol);CHKERRQ(ierr); for (k=0;k<ncols;k++) { if (*(PetscInt*)&(lcid[icol[k]]) >= 0 && pcontrib[icol[k]] != 0.) { if (PetscAbsScalar(pcontrib[icol[k]]) > 0.0) { lni = *(PetscInt*)&(lcid[icol[k]]); pvcol[pncols] = -pcontrib[icol[k]]*diag; picol[pncols] = lni; pncols++; } pcontrib[icol[k]] = 0.; } } ierr = MatRestoreRow(lA[0],ci,&ncols,&icol,&vcol);CHKERRQ(ierr); ierr = MatGetRow(lA[0],i,&ncols,&icol,&vcol);CHKERRQ(ierr); } pcontrib[icol[j]] = 0.; } ierr = MatRestoreRow(lA[0],i,&ncols,&icol,&vcol);CHKERRQ(ierr); } } ci = gidx[i]; li = gidx[i] - fs; if (pncols > 0) { ierr = MatSetValues(*P,1,&ci,pncols,picol,pvcol,INSERT_VALUES);CHKERRQ(ierr); } } } ierr = ISRestoreIndices(lis,&gidx);CHKERRQ(ierr); ierr = VecRestoreArray(lv,&lcid);CHKERRQ(ierr); ierr = PetscFree(pcontrib);CHKERRQ(ierr); ierr = PetscFree(picol);CHKERRQ(ierr); ierr = PetscFree(pvcol);CHKERRQ(ierr); ierr = PetscFree(lsparse);CHKERRQ(ierr); ierr = PetscFree(gsparse);CHKERRQ(ierr); ierr = ISDestroy(&lis);CHKERRQ(ierr); ierr = MatDestroyMatrices(1,&lA);CHKERRQ(ierr); ierr = VecDestroy(&lv);CHKERRQ(ierr); ierr = VecDestroy(&cv);CHKERRQ(ierr); ierr = VecDestroy(&v);CHKERRQ(ierr); ierr = VecScatterDestroy(&lscat);CHKERRQ(ierr); ierr = MatAssemblyBegin(*P, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(*P, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* Mat Pold; ierr = PCGAMGProlongator_Classical(pc,A,G,agg_lists,&Pold);CHKERRQ(ierr); ierr = MatView(Pold,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = MatView(*P,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = MatDestroy(&Pold);CHKERRQ(ierr); */ PetscFunctionReturn(0); }

int main(int argc,char **args) { KSP ksp; PC pc; Mat A; Vec u, x, b; PetscReal error; PetscMPIInt rank, size, sized; PetscInt M = 8, N = 8, m, n, rstart, rend, r; PetscBool userSubdomains = PETSC_FALSE; PetscErrorCode ierr; ierr = PetscInitialize(&argc, &args, NULL,help);if (ierr) return ierr; ierr = PetscOptionsGetInt(NULL,NULL, "-M", &M, NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL, "-N", &N, NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,NULL, "-user_subdomains", &userSubdomains, NULL);CHKERRQ(ierr); /* Do parallel decomposition */ ierr = MPI_Comm_rank(PETSC_COMM_WORLD, &rank);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD, &size);CHKERRQ(ierr); sized = (PetscMPIInt) PetscSqrtReal((PetscReal) size); if (PetscSqr(sized) != size) SETERRQ1(PETSC_COMM_WORLD, PETSC_ERR_ARG_WRONG, "This test may only be run on a nubmer of processes which is a perfect square, not %d", (int) size); if (M % sized) SETERRQ2(PETSC_COMM_WORLD, PETSC_ERR_ARG_WRONG, "The number of x-vertices %D does not divide the number of x-processes %d", M, (int) sized); if (N % sized) SETERRQ2(PETSC_COMM_WORLD, PETSC_ERR_ARG_WRONG, "The number of y-vertices %D does not divide the number of y-processes %d", N, (int) sized); /* Assemble the matrix for the five point stencil, YET AGAIN Every other process will be empty */ ierr = MatCreate(PETSC_COMM_WORLD, &A);CHKERRQ(ierr); m = (sized > 1) ? (rank % 2) ? 0 : 2*M/sized : M; n = N/sized; ierr = MatSetSizes(A, m*n, m*n, M*N, M*N);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSetUp(A);CHKERRQ(ierr); ierr = MatGetOwnershipRange(A, &rstart, &rend);CHKERRQ(ierr); for (r = rstart; r < rend; ++r) { const PetscScalar diag = 4.0, offdiag = -1.0; const PetscInt i = r/N; const PetscInt j = r - i*N; PetscInt c; if (i > 0) {c = r - n; ierr = MatSetValues(A, 1, &r, 1, &c, &offdiag, INSERT_VALUES);CHKERRQ(ierr);} if (i < M-1) {c = r + n; ierr = MatSetValues(A, 1, &r, 1, &c, &offdiag, INSERT_VALUES);CHKERRQ(ierr);} if (j > 0) {c = r - 1; ierr = MatSetValues(A, 1, &r, 1, &c, &offdiag, INSERT_VALUES);CHKERRQ(ierr);} if (j < N-1) {c = r + 1; ierr = MatSetValues(A, 1, &r, 1, &c, &offdiag, INSERT_VALUES);CHKERRQ(ierr);} ierr = MatSetValues(A, 1, &r, 1, &r, &diag, INSERT_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* Setup Solve */ ierr = VecCreate(PETSC_COMM_WORLD, &b);CHKERRQ(ierr); ierr = VecSetSizes(b, m*n, PETSC_DETERMINE);CHKERRQ(ierr); ierr = VecSetFromOptions(b);CHKERRQ(ierr); ierr = VecDuplicate(b, &u);CHKERRQ(ierr); ierr = VecDuplicate(b, &x);CHKERRQ(ierr); ierr = VecSet(u, 1.0);CHKERRQ(ierr); ierr = MatMult(A, u, b);CHKERRQ(ierr); ierr = KSPCreate(PETSC_COMM_WORLD, &ksp);CHKERRQ(ierr); ierr = KSPSetOperators(ksp, A, A);CHKERRQ(ierr); ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr); ierr = PCSetType(pc, PCASM);CHKERRQ(ierr); /* Setup ASM by hand */ if (userSubdomains) { IS is; PetscInt *rows; /* Use no overlap for now */ ierr = PetscMalloc1(rend-rstart, &rows);CHKERRQ(ierr); for (r = rstart; r < rend; ++r) rows[r-rstart] = r; ierr = ISCreateGeneral(PETSC_COMM_SELF, rend-rstart, rows, PETSC_OWN_POINTER, &is);CHKERRQ(ierr); ierr = PCASMSetLocalSubdomains(pc, 1, &is, &is);CHKERRQ(ierr); ierr = ISDestroy(&is);CHKERRQ(ierr); } ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); /* Solve and Compare */ ierr = KSPSolve(ksp, b, x);CHKERRQ(ierr); ierr = VecAXPY(x, -1.0, u);CHKERRQ(ierr); ierr = VecNorm(x, NORM_INFINITY, &error);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD, "Infinity norm of the error: %g\n", (double) error);CHKERRQ(ierr); /* Cleanup */ ierr = KSPDestroy(&ksp);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = VecDestroy(&u);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }

PetscErrorCode PCGAMGGraph_Classical(PC pc,const Mat A,Mat *G) { PetscInt s,f,n,idx,lidx,gidx; PetscInt r,c,ncols; const PetscInt *rcol; const PetscScalar *rval; PetscInt *gcol; PetscScalar *gval; PetscReal rmax; PetscInt cmax = 0; PC_MG *mg; PC_GAMG *gamg; PetscErrorCode ierr; PetscInt *gsparse,*lsparse; PetscScalar *Amax; MatType mtype; PetscFunctionBegin; mg = (PC_MG *)pc->data; gamg = (PC_GAMG *)mg->innerctx; ierr = MatGetOwnershipRange(A,&s,&f);CHKERRQ(ierr); n=f-s; ierr = PetscMalloc(sizeof(PetscInt)*n,&lsparse);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscInt)*n,&gsparse);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscScalar)*n,&Amax);CHKERRQ(ierr); for (r = 0;r < n;r++) { lsparse[r] = 0; gsparse[r] = 0; } for (r = s;r < f;r++) { /* determine the maximum off-diagonal in each row */ rmax = 0.; ierr = MatGetRow(A,r,&ncols,&rcol,&rval);CHKERRQ(ierr); for (c = 0; c < ncols; c++) { if (PetscRealPart(-rval[c]) > rmax && rcol[c] != r) { rmax = PetscRealPart(-rval[c]); } } Amax[r-s] = rmax; if (ncols > cmax) cmax = ncols; lidx = 0; gidx = 0; /* create the local and global sparsity patterns */ for (c = 0; c < ncols; c++) { if (PetscRealPart(-rval[c]) > gamg->threshold*PetscRealPart(Amax[r-s]) || rcol[c] == r) { if (rcol[c] < f && rcol[c] >= s) { lidx++; } else { gidx++; } } } ierr = MatRestoreRow(A,r,&ncols,&rcol,&rval);CHKERRQ(ierr); lsparse[r-s] = lidx; gsparse[r-s] = gidx; } ierr = PetscMalloc(sizeof(PetscScalar)*cmax,&gval);CHKERRQ(ierr); ierr = PetscMalloc(sizeof(PetscInt)*cmax,&gcol);CHKERRQ(ierr); ierr = MatCreate(PetscObjectComm((PetscObject)A),G); CHKERRQ(ierr); ierr = MatGetType(A,&mtype);CHKERRQ(ierr); ierr = MatSetType(*G,mtype);CHKERRQ(ierr); ierr = MatSetSizes(*G,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr); ierr = MatMPIAIJSetPreallocation(*G,0,lsparse,0,gsparse);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(*G,0,lsparse);CHKERRQ(ierr); for (r = s;r < f;r++) { ierr = MatGetRow(A,r,&ncols,&rcol,&rval);CHKERRQ(ierr); idx = 0; for (c = 0; c < ncols; c++) { /* classical strength of connection */ if (PetscRealPart(-rval[c]) > gamg->threshold*PetscRealPart(Amax[r-s]) || rcol[c] == r) { gcol[idx] = rcol[c]; gval[idx] = rval[c]; idx++; } } ierr = MatSetValues(*G,1,&r,idx,gcol,gval,INSERT_VALUES);CHKERRQ(ierr); ierr = MatRestoreRow(A,r,&ncols,&rcol,&rval);CHKERRQ(ierr); } ierr = MatAssemblyBegin(*G, MAT_FINAL_ASSEMBLY); CHKERRQ(ierr); ierr = MatAssemblyEnd(*G, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = PetscFree(gval);CHKERRQ(ierr); ierr = PetscFree(gcol);CHKERRQ(ierr); ierr = PetscFree(lsparse);CHKERRQ(ierr); ierr = PetscFree(gsparse);CHKERRQ(ierr); ierr = PetscFree(Amax);CHKERRQ(ierr); PetscFunctionReturn(0); }

/* MatConvert_Basic - Converts from any input format to another format. For parallel formats, the new matrix distribution is determined by PETSc. Does not do preallocation so in general will be slow */ PetscErrorCode MatConvert_Basic(Mat mat, MatType newtype,MatReuse reuse,Mat *newmat) { Mat M; const PetscScalar *vwork; PetscErrorCode ierr; PetscInt i,j,nz,m,n,rstart,rend,lm,ln,prbs,pcbs,cstart,cend,*dnz,*onz; const PetscInt *cwork; PetscBool isseqsbaij,ismpisbaij,isseqbaij,ismpibaij,isseqdense,ismpidense; PetscFunctionBegin; ierr = MatGetSize(mat,&m,&n);CHKERRQ(ierr); ierr = MatGetLocalSize(mat,&lm,&ln);CHKERRQ(ierr); if (ln == n) ln = PETSC_DECIDE; /* try to preserve column ownership */ ierr = MatCreate(PetscObjectComm((PetscObject)mat),&M);CHKERRQ(ierr); ierr = MatSetSizes(M,lm,ln,m,n);CHKERRQ(ierr); ierr = MatSetBlockSizesFromMats(M,mat,mat);CHKERRQ(ierr); ierr = MatSetType(M,newtype);CHKERRQ(ierr); ierr = MatGetOwnershipRange(mat,&rstart,&rend);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)M,MATSEQSBAIJ,&isseqsbaij);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)M,MATMPISBAIJ,&ismpisbaij);CHKERRQ(ierr); if (isseqsbaij || ismpisbaij) {ierr = MatSetOption(M,MAT_IGNORE_LOWER_TRIANGULAR,PETSC_TRUE);CHKERRQ(ierr);} ierr = PetscObjectTypeCompare((PetscObject)M,MATSEQBAIJ,&isseqbaij);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)M,MATMPIBAIJ,&ismpibaij);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)M,MATSEQDENSE,&isseqdense);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)M,MATMPIDENSE,&ismpidense);CHKERRQ(ierr); if (isseqdense) { ierr = MatSeqDenseSetPreallocation(M,NULL);CHKERRQ(ierr); } else if (ismpidense) { ierr = MatMPIDenseSetPreallocation(M,NULL);CHKERRQ(ierr); } else { /* Preallocation block sizes. (S)BAIJ matrices will have one index per block. */ prbs = (isseqbaij || ismpibaij || isseqsbaij || ismpisbaij) ? PetscAbs(M->rmap->bs) : 1; pcbs = (isseqbaij || ismpibaij || isseqsbaij || ismpisbaij) ? PetscAbs(M->cmap->bs) : 1; ierr = PetscMalloc2(lm/prbs,&dnz,lm/prbs,&onz);CHKERRQ(ierr); ierr = MatGetOwnershipRangeColumn(mat,&cstart,&cend);CHKERRQ(ierr); for (i=0; i<lm; i+=prbs) { ierr = MatGetRow(mat,rstart+i,&nz,&cwork,NULL);CHKERRQ(ierr); dnz[i] = 0; onz[i] = 0; for (j=0; j<nz; j+=pcbs) { if ((isseqsbaij || ismpisbaij) && cwork[j] < rstart+i) continue; if (cstart <= cwork[j] && cwork[j] < cend) dnz[i]++; else onz[i]++; } ierr = MatRestoreRow(mat,rstart+i,&nz,&cwork,NULL);CHKERRQ(ierr); } ierr = MatXAIJSetPreallocation(M,PETSC_DECIDE,dnz,onz,dnz,onz);CHKERRQ(ierr); ierr = PetscFree2(dnz,onz);CHKERRQ(ierr); } for (i=rstart; i<rend; i++) { ierr = MatGetRow(mat,i,&nz,&cwork,&vwork);CHKERRQ(ierr); ierr = MatSetValues(M,1,&i,nz,cwork,vwork,INSERT_VALUES);CHKERRQ(ierr); ierr = MatRestoreRow(mat,i,&nz,&cwork,&vwork);CHKERRQ(ierr); } ierr = MatAssemblyBegin(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); if (reuse == MAT_REUSE_MATRIX) { ierr = MatHeaderReplace(mat,M);CHKERRQ(ierr); } else { *newmat = M; } PetscFunctionReturn(0); }

int main(int argc,char **args) { PetscErrorCode ierr; Mat C; PetscMPIInt rank,size; PetscInt i,m = 5,N,start,end,M; PetscInt idx[4]; PetscScalar Ke[16]; PetscReal h; Vec u,b; KSP ksp; MatNullSpace nullsp; 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); /* Assemble matrix */ ierr = FormElementStiffness(h*h,Ke);CHKERRQ(ierr); /* element stiffness for Laplacian */ 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 right-hand-side and solution vectors */ ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr); ierr = VecSetSizes(u,PETSC_DECIDE,N);CHKERRQ(ierr); ierr = VecSetFromOptions(u);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)u,"Approx. Solution");CHKERRQ(ierr); ierr = VecDuplicate(u,&b);CHKERRQ(ierr); ierr = PetscObjectSetName((PetscObject)b,"Right hand side");CHKERRQ(ierr); ierr = VecSet(b,1.0);CHKERRQ(ierr); ierr = VecSetValue(b,0,1.2,ADD_VALUES);CHKERRQ(ierr); ierr = VecSet(u,0.0);CHKERRQ(ierr); /* Solve linear system */ ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr); ierr = KSPSetOperators(ksp,C,C);CHKERRQ(ierr); ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); ierr = KSPSetInitialGuessNonzero(ksp,PETSC_TRUE);CHKERRQ(ierr); ierr = MatNullSpaceCreate(PETSC_COMM_WORLD,PETSC_TRUE,0,NULL,&nullsp);CHKERRQ(ierr); /* The KSP solver will remove this nullspace from the solution at each iteration */ ierr = MatSetNullSpace(C,nullsp);CHKERRQ(ierr); /* The KSP solver will remove from the right hand side any portion in this nullspace, thus making the linear system consistent. */ ierr = MatSetTransposeNullSpace(C,nullsp);CHKERRQ(ierr); ierr = MatNullSpaceDestroy(&nullsp);CHKERRQ(ierr); ierr = KSPSolve(ksp,b,u);CHKERRQ(ierr); /* Free work space */ ierr = KSPDestroy(&ksp);CHKERRQ(ierr); ierr = VecDestroy(&u);CHKERRQ(ierr); ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }

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; }

int main(int argc,char **argv) { TS ts; /* ODE integrator */ Vec U; /* solution will be stored here */ Mat A; /* Jacobian matrix */ Mat Jacp; /* Jacobian matrix */ PetscErrorCode ierr; PetscMPIInt size; PetscInt n = 2; AppCtx ctx; PetscScalar *u; PetscReal du[2] = {0.0,0.0}; PetscBool ensemble = PETSC_FALSE,flg1,flg2; PetscReal ftime; PetscInt steps; PetscScalar *x_ptr,*y_ptr; Vec lambda[1],q,mu[1]; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize program - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs"); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create necessary matrix and vectors - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr); ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSetUp(A);CHKERRQ(ierr); ierr = MatCreateVecs(A,&U,NULL);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&Jacp);CHKERRQ(ierr); ierr = MatSetSizes(Jacp,PETSC_DECIDE,PETSC_DECIDE,2,1);CHKERRQ(ierr); ierr = MatSetFromOptions(Jacp);CHKERRQ(ierr); ierr = MatSetUp(Jacp);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Swing equation options","");CHKERRQ(ierr); { ctx.beta = 2; ctx.c = 10000.0; ctx.u_s = 1.0; ctx.omega_s = 1.0; ctx.omega_b = 120.0*PETSC_PI; ctx.H = 5.0; ierr = PetscOptionsScalar("-Inertia","","",ctx.H,&ctx.H,NULL);CHKERRQ(ierr); ctx.D = 5.0; ierr = PetscOptionsScalar("-D","","",ctx.D,&ctx.D,NULL);CHKERRQ(ierr); ctx.E = 1.1378; ctx.V = 1.0; ctx.X = 0.545; ctx.Pmax = ctx.E*ctx.V/ctx.X;; ierr = PetscOptionsScalar("-Pmax","","",ctx.Pmax,&ctx.Pmax,NULL);CHKERRQ(ierr); ctx.Pm = 1.1; ierr = PetscOptionsScalar("-Pm","","",ctx.Pm,&ctx.Pm,NULL);CHKERRQ(ierr); ctx.tf = 0.1; ctx.tcl = 0.2; ierr = PetscOptionsReal("-tf","Time to start fault","",ctx.tf,&ctx.tf,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-tcl","Time to end fault","",ctx.tcl,&ctx.tcl,NULL);CHKERRQ(ierr); ierr = PetscOptionsBool("-ensemble","Run ensemble of different initial conditions","",ensemble,&ensemble,NULL);CHKERRQ(ierr); if (ensemble) { ctx.tf = -1; ctx.tcl = -1; } ierr = VecGetArray(U,&u);CHKERRQ(ierr); u[0] = PetscAsinScalar(ctx.Pm/ctx.Pmax); u[1] = 1.0; ierr = PetscOptionsRealArray("-u","Initial solution","",u,&n,&flg1);CHKERRQ(ierr); n = 2; ierr = PetscOptionsRealArray("-du","Perturbation in initial solution","",du,&n,&flg2);CHKERRQ(ierr); u[0] += du[0]; u[1] += du[1]; ierr = VecRestoreArray(U,&u);CHKERRQ(ierr); if (flg1 || flg2) { ctx.tf = -1; ctx.tcl = -1; } } ierr = PetscOptionsEnd();CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr); ierr = TSSetType(ts,TSRK);CHKERRQ(ierr); ierr = TSSetRHSFunction(ts,NULL,(TSRHSFunction)RHSFunction,&ctx);CHKERRQ(ierr); ierr = TSSetRHSJacobian(ts,A,A,(TSRHSJacobian)RHSJacobian,&ctx);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetSolution(ts,U);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Save trajectory of solution so that TSAdjointSolve() may be used - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr); ierr = MatCreateVecs(A,&lambda[0],NULL);CHKERRQ(ierr); /* Set initial conditions for the adjoint integration */ ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr); y_ptr[0] = 0.0; y_ptr[1] = 0.0; ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr); ierr = MatCreateVecs(Jacp,&mu[0],NULL);CHKERRQ(ierr); ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr); x_ptr[0] = -1.0; ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr); ierr = TSSetCostGradients(ts,1,lambda,mu);CHKERRQ(ierr); ierr = TSSetCostIntegrand(ts,1,(PetscErrorCode (*)(TS,PetscReal,Vec,Vec,void*))CostIntegrand, (PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDYFunction, (PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDPFunction,PETSC_TRUE,&ctx);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set solver options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetDuration(ts,PETSC_DEFAULT,10.0);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr); ierr = TSSetFromOptions(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ if (ensemble) { for (du[1] = -2.5; du[1] <= .01; du[1] += .1) { ierr = VecGetArray(U,&u);CHKERRQ(ierr); u[0] = PetscAsinScalar(ctx.Pm/ctx.Pmax); u[1] = ctx.omega_s; u[0] += du[0]; u[1] += du[1]; ierr = VecRestoreArray(U,&u);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr); ierr = TSSolve(ts,U);CHKERRQ(ierr); } } else { ierr = TSSolve(ts,U);CHKERRQ(ierr); } ierr = VecView(U,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr); ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Adjoint model starts here - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Set initial conditions for the adjoint integration */ ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr); y_ptr[0] = 0.0; y_ptr[1] = 0.0; ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr); ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr); x_ptr[0] = -1.0; ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr); /* Set RHS JacobianP */ ierr = TSAdjointSetRHSJacobian(ts,Jacp,RHSJacobianP,&ctx);CHKERRQ(ierr); ierr = TSAdjointSolve(ts);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt initial conditions: d[Psi(tf)]/d[phi0] d[Psi(tf)]/d[omega0]\n");CHKERRQ(ierr); ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = VecView(mu[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = TSGetCostIntegral(ts,&q);CHKERRQ(ierr); ierr = VecView(q,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = VecGetArray(q,&x_ptr);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n cost function=%g\n",(double)(x_ptr[0]-ctx.Pm));CHKERRQ(ierr); ierr = VecRestoreArray(q,&x_ptr);CHKERRQ(ierr); ierr = ComputeSensiP(lambda[0],mu[0],&ctx);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&Jacp);CHKERRQ(ierr); ierr = VecDestroy(&U);CHKERRQ(ierr); ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr); ierr = VecDestroy(&mu[0]);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); PetscFinalize(); return(0); }

int main(int argc,char **argv) { KSP solver; PC pc; Mat A,B; Vec X,Y,Z; MatScalar *a; PetscScalar *b,*x,*y,*z; PetscReal nrm; PetscErrorCode ierr,size=8,lda=10, i,j; PetscInitialize(&argc,&argv,0,help); /* Create matrix and three vectors: these are all normal */ ierr = PetscMalloc1(lda*size,&b);CHKERRQ(ierr); for (i=0; i<size; i++) { for (j=0; j<size; j++) { b[i+j*lda] = rand(); } } ierr = MatCreate(MPI_COMM_SELF,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,size,size,size,size);CHKERRQ(ierr); ierr = MatSetType(A,MATSEQDENSE);CHKERRQ(ierr); ierr = MatSeqDenseSetPreallocation(A,NULL);CHKERRQ(ierr); ierr = MatDenseGetArray(A,&a);CHKERRQ(ierr); for (i=0; i<size; i++) { for (j=0; j<size; j++) { a[i+j*size] = b[i+j*lda]; } } ierr = MatDenseRestoreArray(A,&a);CHKERRQ(ierr); ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatCreate(MPI_COMM_SELF,&B);CHKERRQ(ierr); ierr = MatSetSizes(B,size,size,size,size);CHKERRQ(ierr); ierr = MatSetType(B,MATSEQDENSE);CHKERRQ(ierr); ierr = MatSeqDenseSetPreallocation(B,b);CHKERRQ(ierr); ierr = MatSeqDenseSetLDA(B,lda);CHKERRQ(ierr); ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = PetscMalloc1(size,&x);CHKERRQ(ierr); for (i=0; i<size; i++) x[i] = 1.0; ierr = VecCreateSeqWithArray(MPI_COMM_SELF,1,size,x,&X);CHKERRQ(ierr); ierr = VecAssemblyBegin(X);CHKERRQ(ierr); ierr = VecAssemblyEnd(X);CHKERRQ(ierr); ierr = PetscMalloc1(size,&y);CHKERRQ(ierr); ierr = VecCreateSeqWithArray(MPI_COMM_SELF,1,size,y,&Y);CHKERRQ(ierr); ierr = VecAssemblyBegin(Y);CHKERRQ(ierr); ierr = VecAssemblyEnd(Y);CHKERRQ(ierr); ierr = PetscMalloc1(size,&z);CHKERRQ(ierr); ierr = VecCreateSeqWithArray(MPI_COMM_SELF,1,size,z,&Z);CHKERRQ(ierr); ierr = VecAssemblyBegin(Z);CHKERRQ(ierr); ierr = VecAssemblyEnd(Z);CHKERRQ(ierr); /* * Solve with A and B */ ierr = KSPCreate(MPI_COMM_SELF,&solver);CHKERRQ(ierr); ierr = KSPSetType(solver,KSPPREONLY);CHKERRQ(ierr); ierr = KSPGetPC(solver,&pc);CHKERRQ(ierr); ierr = PCSetType(pc,PCLU);CHKERRQ(ierr); ierr = KSPSetOperators(solver,A,A);CHKERRQ(ierr); ierr = KSPSolve(solver,X,Y);CHKERRQ(ierr); ierr = KSPSetOperators(solver,B,B);CHKERRQ(ierr); ierr = KSPSolve(solver,X,Z);CHKERRQ(ierr); ierr = VecAXPY(Z,-1.0,Y);CHKERRQ(ierr); ierr = VecNorm(Z,NORM_2,&nrm); printf("Test1; error norm=%e\n",nrm); /* Free spaces */ ierr = PetscFree(b);CHKERRQ(ierr); ierr = PetscFree(x);CHKERRQ(ierr); ierr = PetscFree(y);CHKERRQ(ierr); ierr = PetscFree(z);CHKERRQ(ierr); ierr = VecDestroy(&X);CHKERRQ(ierr); ierr = VecDestroy(&Y);CHKERRQ(ierr); ierr = VecDestroy(&Z);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&B);CHKERRQ(ierr); ierr = KSPDestroy(&solver);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }

int main(int argc,char **argv) { SNES snes; /* nonlinear solver context */ Vec x,r; /* solution, residual vectors */ Mat J; /* Jacobian matrix */ PetscErrorCode ierr; PetscScalar *xx; PetscInt i,max_snes_solves = 20,snes_steps_per_solve = 2,criteria_reduce = 1; Ctx ctx; SNESConvergedReason reason; PetscInitialize(&argc,&argv,(char*)0,help); ctx.n = 0; ierr = PetscOptionsGetInt(NULL,"-n",&ctx.n,NULL);CHKERRQ(ierr); ctx.p = 0; ierr = PetscOptionsGetInt(NULL,"-p",&ctx.p,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-max_snes_solves",&max_snes_solves,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-snes_steps_per_solve",&snes_steps_per_solve,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-criteria_reduce",&criteria_reduce,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create nonlinear solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = SNESCreate(PETSC_COMM_WORLD,&snes);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create matrix and vector data structures; set corresponding routines - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Create vectors for solution and nonlinear function */ ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr); ierr = VecSetSizes(x,PETSC_DECIDE,2+ctx.n+ctx.p);CHKERRQ(ierr); ierr = VecSetFromOptions(x);CHKERRQ(ierr); ierr = VecDuplicate(x,&r);CHKERRQ(ierr); /* Create Jacobian matrix data structure */ ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr); ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,2+ctx.p+ctx.n,2+ctx.p+ctx.n);CHKERRQ(ierr); ierr = MatSetFromOptions(J);CHKERRQ(ierr); ierr = MatSetUp(J);CHKERRQ(ierr); /* Set function evaluation routine and vector. */ ierr = SNESSetFunction(snes,r,FormFunction1,(void*)&ctx);CHKERRQ(ierr); /* Set Jacobian matrix data structure and Jacobian evaluation routine */ ierr = SNESSetJacobian(snes,J,J,FormJacobian1,(void*)&ctx);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Customize nonlinear solver; set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = SNESSetFromOptions(snes);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Evaluate initial guess; then solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = VecSet(x,0.0);CHKERRQ(ierr); ierr = VecGetArray(x,&xx);CHKERRQ(ierr); xx[0] = -1.2; for (i=1; i<ctx.p+2; i++) xx[i] = 1.0; ierr = VecRestoreArray(x,&xx);CHKERRQ(ierr); /* Note: The user should initialize the vector, x, with the initial guess for the nonlinear solver prior to calling SNESSolve(). In particular, to employ an initial guess of zero, the user should explicitly set this vector to zero by calling VecSet(). */ ierr = SNESMonitorSet(snes,MonitorRange,0,0);CHKERRQ(ierr); ierr = SNESSetTolerances(snes,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,snes_steps_per_solve,PETSC_DEFAULT);CHKERRQ(ierr); for (i=0; i<max_snes_solves; i++) { ierr = SNESSolve(snes,NULL,x);CHKERRQ(ierr); ierr = SNESGetConvergedReason(snes,&reason);CHKERRQ(ierr); if (reason && reason != SNES_DIVERGED_MAX_IT) break; if (CountGood > criteria_reduce) { ierr = SolveSubproblem(snes);CHKERRQ(ierr); CountGood = 0; } } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&r);CHKERRQ(ierr); ierr = MatDestroy(&J);CHKERRQ(ierr); ierr = SNESDestroy(&snes);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }

int main(int argc, char *argv[]) { // Initialize libMesh libMesh::LibMeshInit init(argc, argv); libMesh::Parallel::Communicator& WorldComm = init.comm(); libMesh::PetscMatrix<libMesh::Number> matrix_A(WorldComm); matrix_A.init(4,4,4,4); matrix_A.set(0,0,1.); // matrix_A.set(0,1,2.); // matrix_A.set(0,2,3.); // matrix_A.set(0,3,4.); // matrix_A.set(1,0,2.); matrix_A.set(1,1,5.); // matrix_A.set(1,2,3.); // matrix_A.set(1,3,7.); // matrix_A.set(2,0,3.); // matrix_A.set(2,1,3.); matrix_A.set(2,2,9.); // matrix_A.set(2,3,6.); // matrix_A.set(3,0,4.); // matrix_A.set(3,1,7.); // matrix_A.set(3,2,6.); matrix_A.set(3,3,1.); matrix_A.close(); Mat dummy_inv_A; MatCreate(PETSC_COMM_WORLD,&dummy_inv_A); MatSetType(dummy_inv_A,MATMPIAIJ); MatSetSizes(dummy_inv_A,PETSC_DECIDE,PETSC_DECIDE,4,4); MatMPIAIJSetPreallocation(dummy_inv_A,2,NULL,0,NULL); MatSetUp(dummy_inv_A); // Dummy matrices // Mat dummy_A, dummy_inv_A; // // libMesh::PetscVector<libMesh::Number> vector_unity(WorldComm,4,4); libMesh::PetscVector<libMesh::Number> vector_dummy_answer(WorldComm,4,4); VecSet(vector_unity.vec(),1); vector_unity.close(); VecSet(vector_dummy_answer.vec(),0); vector_dummy_answer.close(); // Solver // libMesh::PetscLinearSolver<libMesh::Number> KSP_dummy_solver(WorldComm); // KSP_dummy_solver.init(&matrix_A); // KSPSetOperators(KSP_dummy_solver.ksp(),matrix_A.mat(),NULL); KSP ksp; PC pc; KSPCreate(PETSC_COMM_WORLD,&ksp); KSPSetOperators(ksp, matrix_A.mat(), matrix_A.mat()); KSPGetPC(ksp,&pc); PCSetFromOptions(pc); PCType dummy_type; PCGetType(pc,&dummy_type); std::cout << std::endl << dummy_type << std::endl << std::endl; // PCSetType(pc,PCSPAI); // PCHYPRESetType(pc,"parasails"); KSPSetUp(ksp); KSPSolve(ksp,vector_unity.vec(),vector_dummy_answer.vec()); PCComputeExplicitOperator(pc,&dummy_inv_A); // KSPGetOperators(KSP_dummy_solver.ksp(),&dummy_A,&dummy_inv_A); libMesh::PetscMatrix<libMesh::Number> matrix_invA(dummy_inv_A,WorldComm); matrix_invA.close(); // // // KSP_dummy_solver.solve(matrix_A,vector_dummy_answer,vector_unity,1E-5,10000); // // vector_dummy_answer.print_matlab(); // // libMesh::PetscMatrix<libMesh::Number> product_mat(WorldComm); matrix_A.print_matlab(); matrix_invA.print_matlab(); vector_dummy_answer.print_matlab(); return 0; }

int main(int argc,char **args) { Mat C,A; PetscInt i, n = 10,midx[3],bs=1; PetscErrorCode ierr; PetscScalar v[3]; PetscBool flg,isAIJ; MatType type; PetscMPIInt size; ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr; ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-n",&n,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-mat_block_size",&bs,NULL);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr); ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr); ierr = MatSetType(C,MATAIJ);CHKERRQ(ierr); ierr = MatSetFromOptions(C);CHKERRQ(ierr); ierr = MatGetType(C,&type);CHKERRQ(ierr); if (size == 1) { ierr = PetscObjectTypeCompare((PetscObject)C,MATSEQAIJ,&isAIJ);CHKERRQ(ierr); } else { ierr = PetscObjectTypeCompare((PetscObject)C,MATMPIAIJ,&isAIJ);CHKERRQ(ierr); } ierr = MatSeqAIJSetPreallocation(C,3,NULL);CHKERRQ(ierr); ierr = MatMPIAIJSetPreallocation(C,3,NULL,3,NULL);CHKERRQ(ierr); ierr = MatSeqBAIJSetPreallocation(C,bs,3,NULL);CHKERRQ(ierr); ierr = MatMPIBAIJSetPreallocation(C,bs,3,NULL,3,NULL);CHKERRQ(ierr); v[0] = -1.; v[1] = 2.; v[2] = -1.; for (i=1; i<n-1; i++) { midx[2] = i-1; midx[1] = i; midx[0] = i+1; ierr = MatSetValues(C,1,&i,3,midx,v,INSERT_VALUES);CHKERRQ(ierr); } i = 0; midx[0] = 0; midx[1] = 1; v[0] = 2.0; v[1] = -1.; ierr = MatSetValues(C,1,&i,2,midx,v,INSERT_VALUES);CHKERRQ(ierr); i = n-1; midx[0] = n-2; midx[1] = n-1; v[0] = -1.0; v[1] = 2.; ierr = MatSetValues(C,1,&i,2,midx,v,INSERT_VALUES);CHKERRQ(ierr); ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 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 = MatSetUp(A);CHKERRQ(ierr); ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* test matrices with different nonzero patterns - Note: A is created with different nonzero pattern of C! */ ierr = MatCopy(C,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = MatEqual(A,C,&flg);CHKERRQ(ierr); if (!flg) SETERRQ(PETSC_COMM_SELF,1,"MatCopy(C,A,DIFFERENT_NONZERO_PATTERN): Matrices are NOT equal"); ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"A is obtained with MatCopy(,,DIFFERENT_NONZERO_PATTERN):\n");CHKERRQ(ierr); ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); /* test matrices with same nonzero pattern */ ierr = MatDuplicate(C,MAT_DO_NOT_COPY_VALUES,&A);CHKERRQ(ierr); ierr = MatCopy(C,A,SAME_NONZERO_PATTERN);CHKERRQ(ierr); ierr = MatEqual(A,C,&flg);CHKERRQ(ierr); if (!flg) SETERRQ(PETSC_COMM_SELF,1,"MatCopy(C,A,SAME_NONZERO_PATTERN): Matrices are NOT equal"); ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\nA is obtained with MatCopy(,,SAME_NONZERO_PATTERN):\n");CHKERRQ(ierr); ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_COMMON);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"A:\n");CHKERRQ(ierr); ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); /* test MatStore/RetrieveValues() */ if (isAIJ) { ierr = MatSetOption(A,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);CHKERRQ(ierr); ierr = MatStoreValues(A);CHKERRQ(ierr); ierr = MatZeroEntries(A);CHKERRQ(ierr); ierr = MatRetrieveValues(A);CHKERRQ(ierr); } ierr = MatDestroy(&C);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }

int main(int argc,char **argv) { TS ts; /* ODE integrator */ Vec U; /* solution will be stored here */ Mat A; /* Jacobian matrix */ PetscErrorCode ierr; PetscMPIInt size; PetscInt n = 2; AppCtx user; PetscScalar *u; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize program - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs"); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create necessary matrix and vectors - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSetUp(A);CHKERRQ(ierr); ierr = MatGetVecs(A,&U,PETSC_NULL);CHKERRQ(ierr); /* Create wind speed data using Weibull distribution */ ierr = WindSpeeds(&user);CHKERRQ(ierr); /* Set parameters for wind turbine and induction generator */ ierr = SetWindTurbineParams(&user);CHKERRQ(ierr); ierr = SetInductionGeneratorParams(&user);CHKERRQ(ierr); ierr = VecGetArray(U,&u);CHKERRQ(ierr); u[0] = vwa; u[1] = s; ierr = VecRestoreArray(U,&u);CHKERRQ(ierr); /* Create matrix to save solutions at each time step */ user.stepnum = 0; ierr = MatCreateSeqDense(PETSC_COMM_SELF,3,2010,PETSC_NULL,&user.Sol);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr); ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr); ierr = TSSetIFunction(ts,PETSC_NULL,(TSIFunction) IFunction,&user);CHKERRQ(ierr); SNES snes; ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); ierr = SNESSetJacobian(snes,A,A,SNESDefaultComputeJacobian,PETSC_NULL);CHKERRQ(ierr); /* ierr = TSSetIJacobian(ts,A,A,(TSIJacobian)IJacobian,&user);CHKERRQ(ierr); */ ierr = TSSetApplicationContext(ts,&user);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetSolution(ts,U);CHKERRQ(ierr); /* Save initial solution */ PetscScalar *x,*mat; PetscInt idx=3*user.stepnum; ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr); ierr = VecGetArray(U,&x);CHKERRQ(ierr); mat[idx] = 0.0; ierr = PetscMemcpy(mat+idx+1,x,2*sizeof(PetscScalar));CHKERRQ(ierr); ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr); ierr = VecRestoreArray(U,&x);CHKERRQ(ierr); user.stepnum++; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set solver options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetDuration(ts,2000,20.0);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr); ierr = TSSetFromOptions(ts);CHKERRQ(ierr); ierr = TSSetPostStep(ts,SaveSolution);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSolve(ts,U);CHKERRQ(ierr); Mat B; PetscScalar *amat; ierr = MatCreateSeqDense(PETSC_COMM_SELF,3,user.stepnum,PETSC_NULL,&B);CHKERRQ(ierr); ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr); ierr = MatDenseGetArray(B,&amat);CHKERRQ(ierr); ierr = PetscMemcpy(amat,mat,user.stepnum*3*sizeof(PetscScalar));CHKERRQ(ierr); ierr = MatDenseRestoreArray(B,&amat);CHKERRQ(ierr); ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr); PetscViewer viewer; ierr = PetscViewerBinaryOpen(PETSC_COMM_SELF,"out.bin",FILE_MODE_WRITE,&viewer);CHKERRQ(ierr); ierr = MatView(B,viewer);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); ierr = MatDestroy(&user.Sol);CHKERRQ(ierr); ierr = MatDestroy(&B);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = VecDestroy(&user.wind_data);CHKERRQ(ierr); ierr = VecDestroy(&user.t_wind);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = VecDestroy(&U);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = PetscFinalize(); return(0); }

int main(int argc,char **args) { Mat A,B,*submatA,*submatB; PetscInt bs=1,m=11,ov=1,i,j,k,*rows,*cols,nd=5,*idx,rstart,rend,sz,mm,nn,M,N,Mbs; PetscErrorCode ierr; PetscMPIInt size,rank; PetscScalar *vals,rval; IS *is1,*is2; PetscRandom rdm; Vec xx,s1,s2; PetscReal s1norm,s2norm,rnorm,tol = 100*PETSC_SMALL; PetscBool flg,test_nd0=PETSC_FALSE; ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr; ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-mat_block_size",&bs,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-mat_size",&m,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-ov",&ov,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-nd",&nd,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,NULL,"-test_nd0",&test_nd0,NULL);CHKERRQ(ierr); /* Create a AIJ matrix A */ ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,m*bs,m*bs,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr); ierr = MatSetType(A,MATAIJ);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(A,PETSC_DEFAULT,NULL);CHKERRQ(ierr); ierr = MatMPIAIJSetPreallocation(A,PETSC_DEFAULT,NULL,PETSC_DEFAULT,NULL);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSetOption(A,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); /* Create a BAIJ matrix B */ ierr = MatCreate(PETSC_COMM_WORLD,&B);CHKERRQ(ierr); ierr = MatSetSizes(B,m*bs,m*bs,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr); ierr = MatSetType(B,MATBAIJ);CHKERRQ(ierr); ierr = MatSeqBAIJSetPreallocation(B,bs,PETSC_DEFAULT,NULL);CHKERRQ(ierr); ierr = MatMPIBAIJSetPreallocation(B,bs,PETSC_DEFAULT,NULL,PETSC_DEFAULT,NULL);CHKERRQ(ierr); ierr = MatSetFromOptions(B);CHKERRQ(ierr); ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rdm);CHKERRQ(ierr); ierr = PetscRandomSetFromOptions(rdm);CHKERRQ(ierr); ierr = MatGetOwnershipRange(A,&rstart,&rend);CHKERRQ(ierr); ierr = MatGetSize(A,&M,&N);CHKERRQ(ierr); Mbs = M/bs; ierr = PetscMalloc1(bs,&rows);CHKERRQ(ierr); ierr = PetscMalloc1(bs,&cols);CHKERRQ(ierr); ierr = PetscMalloc1(bs*bs,&vals);CHKERRQ(ierr); ierr = PetscMalloc1(M,&idx);CHKERRQ(ierr); /* Now set blocks of values */ for (i=0; i<40*bs; i++) { ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr); cols[0] = bs*(int)(PetscRealPart(rval)*Mbs); ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr); rows[0] = rstart + bs*(int)(PetscRealPart(rval)*m); for (j=1; j<bs; j++) { rows[j] = rows[j-1]+1; cols[j] = cols[j-1]+1; } for (j=0; j<bs*bs; j++) { ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr); vals[j] = rval; } ierr = MatSetValues(A,bs,rows,bs,cols,vals,ADD_VALUES);CHKERRQ(ierr); ierr = MatSetValues(B,bs,rows,bs,cols,vals,ADD_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* Test MatIncreaseOverlap() */ ierr = PetscMalloc1(nd,&is1);CHKERRQ(ierr); ierr = PetscMalloc1(nd,&is2);CHKERRQ(ierr); if (!rank && test_nd0) nd = 0; /* test case */ for (i=0; i<nd; i++) { ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr); sz = (int)(PetscRealPart(rval)*m); for (j=0; j<sz; j++) { ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr); idx[j*bs] = bs*(int)(PetscRealPart(rval)*Mbs); for (k=1; k<bs; k++) idx[j*bs+k] = idx[j*bs]+k; } ierr = ISCreateGeneral(PETSC_COMM_SELF,sz*bs,idx,PETSC_COPY_VALUES,is1+i);CHKERRQ(ierr); ierr = ISCreateGeneral(PETSC_COMM_SELF,sz*bs,idx,PETSC_COPY_VALUES,is2+i);CHKERRQ(ierr); } ierr = MatIncreaseOverlap(A,nd,is1,ov);CHKERRQ(ierr); ierr = MatIncreaseOverlap(B,nd,is2,ov);CHKERRQ(ierr); for (i=0; i<nd; ++i) { ierr = ISEqual(is1[i],is2[i],&flg);CHKERRQ(ierr); if (!flg) { ierr = PetscPrintf(PETSC_COMM_SELF,"i=%D, flg=%d :bs=%D m=%D ov=%D nd=%D np=%D\n",i,flg,bs,m,ov,nd,size);CHKERRQ(ierr); } } for (i=0; i<nd; ++i) { ierr = ISSort(is1[i]);CHKERRQ(ierr); ierr = ISSort(is2[i]);CHKERRQ(ierr); } ierr = MatCreateSubMatrices(B,nd,is2,is2,MAT_INITIAL_MATRIX,&submatB);CHKERRQ(ierr); ierr = MatCreateSubMatrices(A,nd,is1,is1,MAT_INITIAL_MATRIX,&submatA);CHKERRQ(ierr); /* Test MatMult() */ for (i=0; i<nd; i++) { ierr = MatGetSize(submatA[i],&mm,&nn);CHKERRQ(ierr); ierr = VecCreateSeq(PETSC_COMM_SELF,mm,&xx);CHKERRQ(ierr); ierr = VecDuplicate(xx,&s1);CHKERRQ(ierr); ierr = VecDuplicate(xx,&s2);CHKERRQ(ierr); for (j=0; j<3; j++) { ierr = VecSetRandom(xx,rdm);CHKERRQ(ierr); ierr = MatMult(submatA[i],xx,s1);CHKERRQ(ierr); ierr = MatMult(submatB[i],xx,s2);CHKERRQ(ierr); ierr = VecNorm(s1,NORM_2,&s1norm);CHKERRQ(ierr); ierr = VecNorm(s2,NORM_2,&s2norm);CHKERRQ(ierr); rnorm = s2norm-s1norm; if (rnorm<-tol || rnorm>tol) { ierr = PetscPrintf(PETSC_COMM_SELF,"[%d]Error:MatMult - Norm1=%16.14e Norm2=%16.14e\n",rank,s1norm,s2norm);CHKERRQ(ierr); } } ierr = VecDestroy(&xx);CHKERRQ(ierr); ierr = VecDestroy(&s1);CHKERRQ(ierr); ierr = VecDestroy(&s2);CHKERRQ(ierr); } /* Now test MatCreateSubmatrices with MAT_REUSE_MATRIX option */ ierr = MatCreateSubMatrices(A,nd,is1,is1,MAT_REUSE_MATRIX,&submatA);CHKERRQ(ierr); ierr = MatCreateSubMatrices(B,nd,is2,is2,MAT_REUSE_MATRIX,&submatB);CHKERRQ(ierr); /* Test MatMult() */ for (i=0; i<nd; i++) { ierr = MatGetSize(submatA[i],&mm,&nn);CHKERRQ(ierr); ierr = VecCreateSeq(PETSC_COMM_SELF,mm,&xx);CHKERRQ(ierr); ierr = VecDuplicate(xx,&s1);CHKERRQ(ierr); ierr = VecDuplicate(xx,&s2);CHKERRQ(ierr); for (j=0; j<3; j++) { ierr = VecSetRandom(xx,rdm);CHKERRQ(ierr); ierr = MatMult(submatA[i],xx,s1);CHKERRQ(ierr); ierr = MatMult(submatB[i],xx,s2);CHKERRQ(ierr); ierr = VecNorm(s1,NORM_2,&s1norm);CHKERRQ(ierr); ierr = VecNorm(s2,NORM_2,&s2norm);CHKERRQ(ierr); rnorm = s2norm-s1norm; if (rnorm<-tol || rnorm>tol) { ierr = PetscPrintf(PETSC_COMM_SELF,"[%d]Error:MatMult - Norm1=%16.14e Norm2=%16.14e\n",rank,s1norm,s2norm);CHKERRQ(ierr); } } ierr = VecDestroy(&xx);CHKERRQ(ierr); ierr = VecDestroy(&s1);CHKERRQ(ierr); ierr = VecDestroy(&s2);CHKERRQ(ierr); } /* Free allocated memory */ for (i=0; i<nd; ++i) { ierr = ISDestroy(&is1[i]);CHKERRQ(ierr); ierr = ISDestroy(&is2[i]);CHKERRQ(ierr); } ierr = MatDestroySubMatrices(nd,&submatA);CHKERRQ(ierr); ierr = MatDestroySubMatrices(nd,&submatB);CHKERRQ(ierr); ierr = PetscFree(is1);CHKERRQ(ierr); ierr = PetscFree(is2);CHKERRQ(ierr); ierr = PetscFree(idx);CHKERRQ(ierr); ierr = PetscFree(rows);CHKERRQ(ierr); ierr = PetscFree(cols);CHKERRQ(ierr); ierr = PetscFree(vals);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&B);CHKERRQ(ierr); ierr = PetscRandomDestroy(&rdm);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }

PetscInt main(PetscInt argc,char **args) { Mat A,A_dense,B; Vec *evecs; PetscBool flg,TestZHEEV=PETSC_TRUE,TestZHEEVX=PETSC_FALSE,TestZHEGV=PETSC_FALSE,TestZHEGVX=PETSC_FALSE; PetscErrorCode ierr; PetscBool isSymmetric; PetscScalar sigma,*arrayA,*arrayB,*evecs_array=NULL,*work; PetscReal *evals,*rwork; PetscMPIInt size; PetscInt m,i,j,nevs,il,iu,cklvl=2; PetscReal vl,vu,abstol=1.e-8; PetscBLASInt *iwork,*ifail,lwork,lierr,bn; PetscReal tols[2]; PetscInt nzeros[2],nz; PetscReal ratio; PetscScalar v,none = -1.0,sigma2,pfive = 0.5,*xa; PetscRandom rctx; PetscReal h2,sigma1 = 100.0; PetscInt dim,Ii,J,Istart,Iend,n = 6,its,use_random,one=1; 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); if (size != 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"This is a uniprocessor example only!"); ierr = PetscOptionsHasName(NULL, "-test_zheevx", &flg);CHKERRQ(ierr); if (flg) { TestZHEEV = PETSC_FALSE; TestZHEEVX = PETSC_TRUE; } ierr = PetscOptionsHasName(NULL, "-test_zhegv", &flg);CHKERRQ(ierr); if (flg) { TestZHEEV = PETSC_FALSE; TestZHEGV = PETSC_TRUE; } ierr = PetscOptionsHasName(NULL, "-test_zhegvx", &flg);CHKERRQ(ierr); if (flg) { TestZHEEV = PETSC_FALSE; TestZHEGVX = PETSC_TRUE; } ierr = PetscOptionsGetReal(NULL,"-sigma1",&sigma1,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr); dim = n*n; ierr = MatCreate(PETSC_COMM_SELF,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,dim,dim);CHKERRQ(ierr); ierr = MatSetType(A,MATSEQDENSE);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = PetscOptionsHasName(NULL,"-norandom",&flg);CHKERRQ(ierr); if (flg) use_random = 0; else use_random = 1; if (use_random) { ierr = PetscRandomCreate(PETSC_COMM_SELF,&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=0; Ii<dim; 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; ierr = MatSetValues(A,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr); } /* make A complex Hermitian */ v = sigma2*h2; Ii = 0; J = 1; 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); if (use_random) {ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);} ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); m = n = dim; /* Check whether A is symmetric */ ierr = PetscOptionsHasName(NULL, "-check_symmetry", &flg);CHKERRQ(ierr); if (flg) { Mat Trans; ierr = MatTranspose(A,MAT_INITIAL_MATRIX, &Trans); ierr = MatEqual(A, Trans, &isSymmetric); if (!isSymmetric) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"A must be symmetric"); ierr = MatDestroy(&Trans);CHKERRQ(ierr); } /* Convert aij matrix to MatSeqDense for LAPACK */ ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&flg);CHKERRQ(ierr); if (flg) { ierr = MatDuplicate(A,MAT_COPY_VALUES,&A_dense);CHKERRQ(ierr); } else { ierr = MatConvert(A,MATSEQDENSE,MAT_INITIAL_MATRIX,&A_dense);CHKERRQ(ierr); } ierr = MatCreate(PETSC_COMM_SELF,&B);CHKERRQ(ierr); ierr = MatSetSizes(B,PETSC_DECIDE,PETSC_DECIDE,dim,dim);CHKERRQ(ierr); ierr = MatSetType(B,MATSEQDENSE);CHKERRQ(ierr); ierr = MatSetFromOptions(B);CHKERRQ(ierr); v = 1.0; for (Ii=0; Ii<dim; Ii++) { ierr = MatSetValues(B,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr); } /* Solve standard eigenvalue problem: A*x = lambda*x */ /*===================================================*/ ierr = PetscBLASIntCast(2*n,&lwork);CHKERRQ(ierr); ierr = PetscBLASIntCast(n,&bn);CHKERRQ(ierr); ierr = PetscMalloc(n*sizeof(PetscReal),&evals);CHKERRQ(ierr); ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr); ierr = MatDenseGetArray(A_dense,&arrayA);CHKERRQ(ierr); if (TestZHEEV) { /* test zheev() */ printf(" LAPACKsyev: compute all %d eigensolutions...\n",m); ierr = PetscMalloc((3*n-2)*sizeof(PetscReal),&rwork);CHKERRQ(ierr); LAPACKsyev_("V","U",&bn,arrayA,&bn,evals,work,&lwork,rwork,&lierr); ierr = PetscFree(rwork);CHKERRQ(ierr); evecs_array = arrayA; nevs = m; il =1; iu=m; } if (TestZHEEVX) { il = 1; ierr = PetscBLASIntCast((0.2*m),&iu);CHKERRQ(ierr); printf(" LAPACKsyevx: compute %d to %d-th eigensolutions...\n",il,iu); ierr = PetscMalloc((m*n+1)*sizeof(PetscScalar),&evecs_array);CHKERRQ(ierr); ierr = PetscMalloc((7*n+1)*sizeof(PetscReal),&rwork);CHKERRQ(ierr); ierr = PetscMalloc((5*n+1)*sizeof(PetscBLASInt),&iwork);CHKERRQ(ierr); ierr = PetscMalloc((n+1)*sizeof(PetscBLASInt),&ifail);CHKERRQ(ierr); /* in the case "I", vl and vu are not referenced */ vl = 0.0; vu = 8.0; LAPACKsyevx_("V","I","U",&bn,arrayA,&bn,&vl,&vu,&il,&iu,&abstol,&nevs,evals,evecs_array,&n,work,&lwork,rwork,iwork,ifail,&lierr); ierr = PetscFree(iwork);CHKERRQ(ierr); ierr = PetscFree(ifail);CHKERRQ(ierr); ierr = PetscFree(rwork);CHKERRQ(ierr); } if (TestZHEGV) { printf(" LAPACKsygv: compute all %d eigensolutions...\n",m); ierr = PetscMalloc((3*n+1)*sizeof(PetscReal),&rwork);CHKERRQ(ierr); ierr = MatDenseGetArray(B,&arrayB);CHKERRQ(ierr); LAPACKsygv_(&one,"V","U",&bn,arrayA,&bn,arrayB,&bn,evals,work,&lwork,rwork,&lierr); evecs_array = arrayA; nevs = m; il = 1; iu=m; ierr = MatDenseRestoreArray(B,&arrayB);CHKERRQ(ierr); ierr = PetscFree(rwork);CHKERRQ(ierr); } if (TestZHEGVX) { il = 1; ierr = PetscBLASIntCast((0.2*m),&iu);CHKERRQ(ierr); printf(" LAPACKsygv: compute %d to %d-th eigensolutions...\n",il,iu); ierr = PetscMalloc((m*n+1)*sizeof(PetscScalar),&evecs_array);CHKERRQ(ierr); ierr = PetscMalloc((6*n+1)*sizeof(PetscBLASInt),&iwork);CHKERRQ(ierr); ifail = iwork + 5*n; ierr = PetscMalloc((7*n+1)*sizeof(PetscReal),&rwork);CHKERRQ(ierr); ierr = MatDenseGetArray(B,&arrayB);CHKERRQ(ierr); vl = 0.0; vu = 8.0; LAPACKsygvx_(&one,"V","I","U",&bn,arrayA,&bn,arrayB,&bn,&vl,&vu,&il,&iu,&abstol,&nevs,evals,evecs_array,&n,work,&lwork,rwork,iwork,ifail,&lierr); ierr = MatDenseRestoreArray(B,&arrayB);CHKERRQ(ierr); ierr = PetscFree(iwork);CHKERRQ(ierr); ierr = PetscFree(rwork);CHKERRQ(ierr); } ierr = MatDenseRestoreArray(A_dense,&arrayA);CHKERRQ(ierr); if (nevs <= 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_CONV_FAILED, "nev=%d, no eigensolution has found", nevs); /* View evals */ ierr = PetscOptionsHasName(NULL, "-eig_view", &flg);CHKERRQ(ierr); if (flg) { printf(" %d evals: \n",nevs); for (i=0; i<nevs; i++) printf("%d %G\n",i+il,evals[i]); } /* Check residuals and orthogonality */ ierr = PetscMalloc((nevs+1)*sizeof(Vec),&evecs);CHKERRQ(ierr); for (i=0; i<nevs; i++) { ierr = VecCreate(PETSC_COMM_SELF,&evecs[i]);CHKERRQ(ierr); ierr = VecSetSizes(evecs[i],PETSC_DECIDE,n);CHKERRQ(ierr); ierr = VecSetFromOptions(evecs[i]);CHKERRQ(ierr); ierr = VecPlaceArray(evecs[i],evecs_array+i*n);CHKERRQ(ierr); } tols[0] = 1.e-8; tols[1] = 1.e-8; ierr = CkEigenSolutions(cklvl,A,il-1,iu-1,evals,evecs,tols);CHKERRQ(ierr); for (i=0; i<nevs; i++) { ierr = VecDestroy(&evecs[i]);CHKERRQ(ierr);} ierr = PetscFree(evecs);CHKERRQ(ierr); /* Free work space. */ if (TestZHEEVX || TestZHEGVX) { ierr = PetscFree(evecs_array);CHKERRQ(ierr); } ierr = PetscFree(evals);CHKERRQ(ierr); ierr = PetscFree(work);CHKERRQ(ierr); ierr = MatDestroy(&A_dense);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&B);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }

int main(int argc,char **argv) { SNES snes; /* nonlinear solver context */ KSP ksp; /* linear solver context */ PC pc; /* preconditioner context */ Vec x,r; /* solution, residual vectors */ Mat J; /* Jacobian matrix */ PetscErrorCode ierr; PetscInt its; PetscMPIInt size; PetscScalar pfive = .5,*xx; PetscBool flg; PetscInitialize(&argc,&argv,(char*)0,help); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size != 1) SETERRQ(PETSC_COMM_SELF,1,"This is a uniprocessor example only!"); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create nonlinear solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = SNESCreate(PETSC_COMM_WORLD,&snes);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create matrix and vector data structures; set corresponding routines - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Create vectors for solution and nonlinear function */ ierr = VecCreateSeq(PETSC_COMM_SELF,2,&x);CHKERRQ(ierr); ierr = VecDuplicate(x,&r);CHKERRQ(ierr); /* Create Jacobian matrix data structure */ ierr = MatCreate(PETSC_COMM_SELF,&J);CHKERRQ(ierr); ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,2,2);CHKERRQ(ierr); ierr = MatSetFromOptions(J);CHKERRQ(ierr); ierr = PetscOptionsHasName(NULL,"-hard",&flg);CHKERRQ(ierr); if (!flg) { /* Set function evaluation routine and vector. */ ierr = SNESSetFunction(snes,r,FormFunction1,NULL);CHKERRQ(ierr); /* Set Jacobian matrix data structure and Jacobian evaluation routine */ ierr = SNESSetJacobian(snes,J,J,FormJacobian1,NULL);CHKERRQ(ierr); } else { ierr = SNESSetFunction(snes,r,FormFunction2,NULL);CHKERRQ(ierr); ierr = SNESSetJacobian(snes,J,J,FormJacobian2,NULL);CHKERRQ(ierr); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Customize nonlinear solver; set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Set linear solver defaults for this problem. By extracting the KSP, KSP, and PC contexts from the SNES context, we can then directly call any KSP, KSP, and PC routines to set various options. */ ierr = SNESGetKSP(snes,&ksp);CHKERRQ(ierr); ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr); ierr = PCSetType(pc,PCNONE);CHKERRQ(ierr); ierr = KSPSetTolerances(ksp,1.e-4,PETSC_DEFAULT,PETSC_DEFAULT,20);CHKERRQ(ierr); /* Set SNES/KSP/KSP/PC runtime options, e.g., -snes_view -snes_monitor -ksp_type <ksp> -pc_type <pc> These options will override those specified above as long as SNESSetFromOptions() is called _after_ any other customization routines. */ ierr = SNESSetFromOptions(snes);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Evaluate initial guess; then solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ if (!flg) { ierr = VecSet(x,pfive);CHKERRQ(ierr); } else { ierr = VecGetArray(x,&xx);CHKERRQ(ierr); xx[0] = 2.0; xx[1] = 3.0; ierr = VecRestoreArray(x,&xx);CHKERRQ(ierr); } /* Note: The user should initialize the vector, x, with the initial guess for the nonlinear solver prior to calling SNESSolve(). In particular, to employ an initial guess of zero, the user should explicitly set this vector to zero by calling VecSet(). */ ierr = SNESSolve(snes,NULL,x);CHKERRQ(ierr); ierr = SNESGetIterationNumber(snes,&its);CHKERRQ(ierr); if (flg) { Vec f; ierr = VecView(x,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = SNESGetFunction(snes,&f,0,0);CHKERRQ(ierr); ierr = VecView(r,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } ierr = PetscPrintf(PETSC_COMM_SELF,"number of SNES iterations = %D\n\n",its);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&r);CHKERRQ(ierr); ierr = MatDestroy(&J);CHKERRQ(ierr); ierr = SNESDestroy(&snes);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }