/* Initialize M-Matrix with appropriate stencil */
PetscErrorCode InitializeLaplaceMatrix(DMMG dmmg,Mat J,Mat M)
{
State *BHD;
PData PD;
DA da;
int x[3], n[3], i[3], N[3], dim, border;
MatStencil col[3],row;
PetscScalar v[3], vb=1.0;
real h[3], L, zpad;
PetscPrintf(PETSC_COMM_WORLD,"Assembling Matrix...");
BHD = (State*) dmmg->user;
da = (DA)dmmg->dm;
PD = BHD->PD;
MatZeroEntries(M);
L= PD->interval[1]-PD->interval[0];
zpad = BHD->zpad;
DAGetInfo(da,0,&(N[0]),&(N[1]),&(N[2]),0,0,0,0,0,0,0);
PetscPrintf(PETSC_COMM_WORLD,"%d %d %d \n", N[0], N[1], N[2]);
FOR_DIM
h[dim] = L/N[dim];
border = (int) ceil( ((PD->interval[1]-PD->interval[0])-(2.*zpad))/h[0]/2. );
/* Get local portion of the grid */
DAGetCorners(da, &(x[0]), &(x[1]), &(x[2]), &(n[0]), &(n[1]), &(n[2]));
/* loop over local portion of grid */
for(i[2]=x[2]; i[2]<x[2]+n[2]; i[2]++)
for(i[1]=x[1]; i[1]<x[1]+n[1]; i[1]++)
for(i[0]=x[0]; i[0]<x[0]+n[0]; i[0]++)
{
FOR_DIM
{
col[dim].i=i[0];
col[dim].j=i[1];
col[dim].k=i[2];
row.i=i[0];
row.j=i[1];
row.k=i[2];
}
/* Boundary */
if( i[0] <= border+1 || i[1] <= border+1 || i[2] <= border+1)
MatSetValuesStencil(M,1,&row,1,col+1,&vb,ADD_VALUES);
else if( i[0]>=N[0]-1-border || i[1]>=N[1]-1-border || i[2]>=N[2]-1-border)
MatSetValuesStencil(M,1,&row,1,col+1,&vb,ADD_VALUES);
else
{
FOR_DIM
{
/* position in matrix */
switch(dim)
{
case 0: col[0].i -= 1; col[2].i += 1;break;
case 1: col[0].j -= 1; col[2].j += 1;break;
case 2: col[0].k -= 1; col[2].k += 1;break;
}
/* values to enter */
v[0]=1.0/SQR(h[dim]);
v[1]=-2.0/SQR(h[dim]);
v[2]=+1.0/SQR(h[dim]);
MatSetValuesStencil(M,1,&row,3,col,v,ADD_VALUES);
switch(dim)
{
case 0: col[0].i += 1; col[2].i -= 1;break;
case 1: col[0].j += 1; col[2].j -= 1;break;
case 2: col[0].k += 1; col[2].k -= 1;break;
}
}
}
}
MatAssemblyBegin(M,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(M,MAT_FINAL_ASSEMBLY);
PetscPrintf(PETSC_COMM_WORLD,"done.\n");
return 0;
}
int main(int argc,char **args)
{
Vec x,b;
Mat A,U,V,LR;
PetscInt i,j,Ii,J,Istart,Iend,m = 8,n = 7,rstart,rend;
PetscErrorCode ierr;
PetscBool flg;
PetscScalar *u,a;
PetscInitialize(&argc,&args,(char *)0,help);
ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the sparse matrix
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
for (Ii=Istart; Ii<Iend; Ii++) {
a = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {J = Ii - n; ierr = MatSetValues(A,1,&Ii,1,&J,&a,INSERT_VALUES);CHKERRQ(ierr);}
if (i<m-1) {J = Ii + n; ierr = MatSetValues(A,1,&Ii,1,&J,&a,INSERT_VALUES);CHKERRQ(ierr);}
if (j>0) {J = Ii - 1; ierr = MatSetValues(A,1,&Ii,1,&J,&a,INSERT_VALUES);CHKERRQ(ierr);}
if (j<n-1) {J = Ii + 1; ierr = MatSetValues(A,1,&Ii,1,&J,&a,INSERT_VALUES);CHKERRQ(ierr);}
a = 4.0; ierr = MatSetValues(A,1,&Ii,1,&Ii,&a,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the dense matrices
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&U);CHKERRQ(ierr);
ierr = MatSetSizes(U,PETSC_DECIDE,PETSC_DECIDE,m*n,3);CHKERRQ(ierr);
ierr = MatSetType(U,MATDENSE);CHKERRQ(ierr);
ierr = MatSetUp(U);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(U,&rstart,&rend);CHKERRQ(ierr);
ierr = MatDenseGetArray(U,&u);CHKERRQ(ierr);
for (i=rstart; i<rend; i++) {
u[i-rstart] = (PetscReal)i;
u[i+rend-2*rstart] = (PetscReal)1000*i;
u[i+2*rend-3*rstart] = (PetscReal)100000*i;
}
ierr = MatDenseRestoreArray(U,&u);CHKERRQ(ierr);
ierr = MatAssemblyBegin(U,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(U,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&V);CHKERRQ(ierr);
ierr = MatSetSizes(V,PETSC_DECIDE,PETSC_DECIDE,m*n,3);CHKERRQ(ierr);
ierr = MatSetType(V,MATDENSE);CHKERRQ(ierr);
ierr = MatSetUp(V);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(U,&rstart,&rend);CHKERRQ(ierr);
ierr = MatDenseGetArray(V,&u);CHKERRQ(ierr);
for (i=rstart; i<rend; i++) {
u[i-rstart] = (PetscReal)i;
u[i+rend-2*rstart] = (PetscReal)1.2*i;
u[i+2*rend-3*rstart] = (PetscReal)1.67*i+2;
}
ierr = MatDenseRestoreArray(V,&u);CHKERRQ(ierr);
ierr = MatAssemblyBegin(V,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(V,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create low rank created matrix
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreateLRC(A,U,V,&LR);CHKERRQ(ierr);
ierr = MatSetUp(LR);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create test vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr);
ierr = VecSetSizes(x,PETSC_DECIDE,m*n);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&b);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(x,&rstart,&rend);CHKERRQ(ierr);
ierr = VecGetArray(x,&u);CHKERRQ(ierr);
for (i=rstart; i<rend; i++) u[i-rstart] = (PetscScalar)i;
ierr = VecRestoreArray(x,&u);CHKERRQ(ierr);
ierr = MatMult(LR,x,b);CHKERRQ(ierr);
/*
View the product if desired
*/
ierr = PetscOptionsHasName(PETSC_NULL,"-view_product",&flg);CHKERRQ(ierr);
if (flg) {ierr = VecView(b,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);}
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
/* you can destroy the matrices in any order you like */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&U);CHKERRQ(ierr);
ierr = MatDestroy(&V);CHKERRQ(ierr);
ierr = MatDestroy(&LR);CHKERRQ(ierr);
/*
Always call PetscFinalize() before exiting a program. This routine
- finalizes the PETSc libraries as well as MPI
- provides summary and diagnostic information if certain runtime
options are chosen (e.g., -log_summary).
*/
ierr = PetscFinalize();
return 0;
}
PetscErrorCode heavyEdgeMatchAgg(IS perm,Mat a_Gmat,PetscInt verbose,PetscCoarsenData **a_locals_llist)
{
PetscErrorCode ierr;
PetscBool isMPI;
MPI_Comm wcomm = ((PetscObject)a_Gmat)->comm;
PetscInt sub_it,kk,n,ix,*idx,*ii,iter,Iend,my0;
PetscMPIInt rank,size;
const PetscInt nloc = a_Gmat->rmap->n,n_iter=6; /* need to figure out how to stop this */
PetscInt *lid_cprowID,*lid_gid;
PetscBool *lid_matched;
Mat_SeqAIJ *matA, *matB=0;
Mat_MPIAIJ *mpimat=0;
PetscScalar one=1.;
PetscCoarsenData *agg_llists = PETSC_NULL,*deleted_list = PETSC_NULL;
Mat cMat,tMat,P;
MatScalar *ap;
PetscMPIInt tag1,tag2;
PetscFunctionBegin;
ierr = MPI_Comm_rank(wcomm, &rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(wcomm, &size);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(a_Gmat, &my0, &Iend);CHKERRQ(ierr);
ierr = PetscCommGetNewTag(wcomm, &tag1);CHKERRQ(ierr);
ierr = PetscCommGetNewTag(wcomm, &tag2);CHKERRQ(ierr);
ierr = PetscMalloc(nloc*sizeof(PetscInt), &lid_gid);CHKERRQ(ierr); /* explicit array needed */
ierr = PetscMalloc(nloc*sizeof(PetscInt), &lid_cprowID);CHKERRQ(ierr);
ierr = PetscMalloc(nloc*sizeof(PetscBool), &lid_matched);CHKERRQ(ierr);
ierr = PetscCDCreate(nloc, &agg_llists);CHKERRQ(ierr);
/* ierr = PetscCDSetChuckSize(agg_llists, nloc+1);CHKERRQ(ierr); */
*a_locals_llist = agg_llists;
ierr = PetscCDCreate(size, &deleted_list);CHKERRQ(ierr);
ierr = PetscCDSetChuckSize(deleted_list, 100);CHKERRQ(ierr);
/* setup 'lid_gid' for scatters and add self to all lists */
for (kk=0;kk<nloc;kk++) {
lid_gid[kk] = kk + my0;
ierr = PetscCDAppendID(agg_llists, kk, my0+kk);CHKERRQ(ierr);
}
/* make a copy of the graph, this gets destroyed in iterates */
ierr = MatDuplicate(a_Gmat,MAT_COPY_VALUES,&cMat);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)a_Gmat, MATMPIAIJ, &isMPI);CHKERRQ(ierr);
iter = 0;
while(iter++ < n_iter) {
PetscScalar *cpcol_gid,*cpcol_max_ew,*cpcol_max_pe,*lid_max_ew;
PetscBool *cpcol_matched;
PetscMPIInt *cpcol_pe,proc;
Vec locMaxEdge,locMaxPE,ghostMaxEdge,ghostMaxPE;
PetscInt nEdges,n_nz_row,jj;
Edge *Edges;
PetscInt gid;
const PetscInt *perm_ix, n_sub_its = 120;
/* get submatrices of cMat */
if (isMPI) {
mpimat = (Mat_MPIAIJ*)cMat->data;
matA = (Mat_SeqAIJ*)mpimat->A->data;
matB = (Mat_SeqAIJ*)mpimat->B->data;
/* force compressed storage of B */
matB->compressedrow.check = PETSC_TRUE;
ierr = MatCheckCompressedRow(mpimat->B,&matB->compressedrow,matB->i,cMat->rmap->n,-1.0);CHKERRQ(ierr);
assert(matB->compressedrow.use);
} else {
matA = (Mat_SeqAIJ*)cMat->data;
}
assert(matA && !matA->compressedrow.use);
assert(matB==0 || matB->compressedrow.use);
/* set max edge on nodes */
ierr = MatGetVecs(cMat, &locMaxEdge, 0);CHKERRQ(ierr);
ierr = MatGetVecs(cMat, &locMaxPE, 0);CHKERRQ(ierr);
/* get 'cpcol_pe' & 'cpcol_gid' & init. 'cpcol_matched' using 'mpimat->lvec' */
if (mpimat) {
Vec vec;
PetscScalar vval;
ierr = MatGetVecs(cMat, &vec, 0);CHKERRQ(ierr);
/* cpcol_pe */
vval = (PetscScalar)(rank);
for (kk=0,gid=my0;kk<nloc;kk++,gid++) {
ierr = VecSetValues(vec, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr); /* set with GID */
}
ierr = VecAssemblyBegin(vec);CHKERRQ(ierr);
ierr = VecAssemblyEnd(vec);CHKERRQ(ierr);
ierr = VecScatterBegin(mpimat->Mvctx,vec,mpimat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(mpimat->Mvctx,vec,mpimat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecGetArray(mpimat->lvec, &cpcol_gid);CHKERRQ(ierr); /* get proc ID in 'cpcol_gid' */
ierr = VecGetLocalSize(mpimat->lvec, &n);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscInt), &cpcol_pe);CHKERRQ(ierr);
for (kk=0;kk<n;kk++) cpcol_pe[kk] = (PetscMPIInt)PetscRealPart(cpcol_gid[kk]);
ierr = VecRestoreArray(mpimat->lvec, &cpcol_gid);CHKERRQ(ierr);
/* cpcol_gid */
for (kk=0,gid=my0;kk<nloc;kk++,gid++) {
vval = (PetscScalar)(gid);
ierr = VecSetValues(vec, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr); /* set with GID */
}
ierr = VecAssemblyBegin(vec);CHKERRQ(ierr);
ierr = VecAssemblyEnd(vec);CHKERRQ(ierr);
ierr = VecScatterBegin(mpimat->Mvctx,vec,mpimat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(mpimat->Mvctx,vec,mpimat->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecDestroy(&vec);CHKERRQ(ierr);
ierr = VecGetArray(mpimat->lvec, &cpcol_gid);CHKERRQ(ierr); /* get proc ID in 'cpcol_gid' */
/* cpcol_matched */
ierr = VecGetLocalSize(mpimat->lvec, &n);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscBool), &cpcol_matched);CHKERRQ(ierr);
for (kk=0;kk<n;kk++) cpcol_matched[kk] = PETSC_FALSE;
}
/* need an inverse map - locals */
for (kk=0;kk<nloc;kk++) lid_cprowID[kk] = -1;
/* set index into compressed row 'lid_cprowID' */
if (matB) {
ii = matB->compressedrow.i;
for (ix=0; ix<matB->compressedrow.nrows; ix++) {
lid_cprowID[matB->compressedrow.rindex[ix]] = ix;
}
}
/* get removed IS, use '' */
/* if (iter==1) { */
/* PetscInt *lid_rem,idx; */
/* ierr = PetscMalloc(nloc*sizeof(PetscInt), &lid_rem);CHKERRQ(ierr); */
/* for (kk=idx=0;kk<nloc;kk++){ */
/* PetscInt nn,lid=kk; */
/* ii = matA->i; nn = ii[lid+1] - ii[lid]; */
/* if ((ix=lid_cprowID[lid]) != -1) { /\* if I have any ghost neighbors *\/ */
/* ii = matB->compressedrow.i; */
/* nn += ii[ix+1] - ii[ix]; */
/* } */
/* if (nn < 2) { */
/* lid_rem[idx++] = kk + my0; */
/* } */
/* } */
/* ierr = PetscCDSetRemovedIS(agg_llists, wcomm, idx, lid_rem);CHKERRQ(ierr); */
/* ierr = PetscFree(lid_rem);CHKERRQ(ierr); */
/* } */
/* compute 'locMaxEdge' & 'locMaxPE', and create list of edges, count edges' */
for (nEdges=0,kk=0,gid=my0;kk<nloc;kk++,gid++){
PetscReal max_e = 0., tt;
PetscScalar vval;
PetscInt lid = kk;
PetscMPIInt max_pe=rank,pe;
ii = matA->i; n = ii[lid+1] - ii[lid]; idx = matA->j + ii[lid];
ap = matA->a + ii[lid];
for (jj=0; jj<n; jj++) {
PetscInt lidj = idx[jj];
if (lidj != lid && PetscRealPart(ap[jj]) > max_e) max_e = PetscRealPart(ap[jj]);
if (lidj > lid) nEdges++;
}
if ((ix=lid_cprowID[lid]) != -1) { /* if I have any ghost neighbors */
ii = matB->compressedrow.i; n = ii[ix+1] - ii[ix];
ap = matB->a + ii[ix];
idx = matB->j + ii[ix];
for (jj=0 ; jj<n ; jj++) {
if ((tt=PetscRealPart(ap[jj])) > max_e) max_e = tt;
nEdges++;
if ((pe=cpcol_pe[idx[jj]]) > max_pe) max_pe = pe;
}
}
vval = max_e;
ierr = VecSetValues(locMaxEdge, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr);
vval = (PetscScalar)max_pe;
ierr = VecSetValues(locMaxPE, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(locMaxEdge);CHKERRQ(ierr);
ierr = VecAssemblyEnd(locMaxEdge);CHKERRQ(ierr);
ierr = VecAssemblyBegin(locMaxPE);CHKERRQ(ierr);
ierr = VecAssemblyEnd(locMaxPE);CHKERRQ(ierr);
/* get 'cpcol_max_ew' & 'cpcol_max_pe' */
if (mpimat) {
ierr = VecDuplicate(mpimat->lvec, &ghostMaxEdge);CHKERRQ(ierr);
ierr = VecScatterBegin(mpimat->Mvctx,locMaxEdge,ghostMaxEdge,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(mpimat->Mvctx,locMaxEdge,ghostMaxEdge,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecGetArray(ghostMaxEdge, &cpcol_max_ew);CHKERRQ(ierr);
ierr = VecDuplicate(mpimat->lvec, &ghostMaxPE);CHKERRQ(ierr);
ierr = VecScatterBegin(mpimat->Mvctx,locMaxPE,ghostMaxPE,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(mpimat->Mvctx,locMaxPE,ghostMaxPE,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecGetArray(ghostMaxPE, &cpcol_max_pe);CHKERRQ(ierr);
}
/* setup sorted list of edges */
ierr = PetscMalloc(nEdges*sizeof(Edge), &Edges);CHKERRQ(ierr);
ierr = ISGetIndices(perm, &perm_ix);CHKERRQ(ierr);
for (nEdges=n_nz_row=kk=0;kk<nloc;kk++){
PetscInt nn, lid = perm_ix[kk];
ii = matA->i; nn = n = ii[lid+1] - ii[lid]; idx = matA->j + ii[lid];
ap = matA->a + ii[lid];
for (jj=0; jj<n; jj++) {
PetscInt lidj = idx[jj]; assert(PetscRealPart(ap[jj])>0.);
if (lidj > lid) {
Edges[nEdges].lid0 = lid;
Edges[nEdges].gid1 = lidj + my0;
Edges[nEdges].cpid1 = -1;
Edges[nEdges].weight = PetscRealPart(ap[jj]);
nEdges++;
}
}
if ((ix=lid_cprowID[lid]) != -1) { /* if I have any ghost neighbors */
ii = matB->compressedrow.i; n = ii[ix+1] - ii[ix];
ap = matB->a + ii[ix];
idx = matB->j + ii[ix];
nn += n;
for (jj=0 ; jj<n ; jj++) {
assert(PetscRealPart(ap[jj])>0.);
Edges[nEdges].lid0 = lid;
Edges[nEdges].gid1 = (PetscInt)PetscRealPart(cpcol_gid[idx[jj]]);
Edges[nEdges].cpid1 = idx[jj];
Edges[nEdges].weight = PetscRealPart(ap[jj]);
nEdges++;
}
}
if (nn > 1) n_nz_row++;
else if (iter == 1){
/* should select this because it is technically in the MIS but lets not */
ierr = PetscCDRemoveAll(agg_llists, lid);CHKERRQ(ierr);
}
}
ierr = ISRestoreIndices(perm,&perm_ix);CHKERRQ(ierr);
qsort(Edges, nEdges, sizeof(Edge), gamg_hem_compare);
/* projection matrix */
ierr = MatCreateAIJ(wcomm, nloc, nloc, PETSC_DETERMINE, PETSC_DETERMINE, 1, 0, 1, 0, &P);CHKERRQ(ierr);
/* clear matched flags */
for (kk=0;kk<nloc;kk++) lid_matched[kk] = PETSC_FALSE;
/* process - communicate - process */
for (sub_it=0;sub_it<n_sub_its;sub_it++){
PetscInt nactive_edges;
ierr = VecGetArray(locMaxEdge, &lid_max_ew);CHKERRQ(ierr);
for (kk=nactive_edges=0;kk<nEdges;kk++){
/* HEM */
const Edge *e = &Edges[kk];
const PetscInt lid0=e->lid0,gid1=e->gid1,cpid1=e->cpid1,gid0=lid0+my0,lid1=gid1-my0;
PetscBool isOK = PETSC_TRUE;
/* skip if either (local) vertex is done already */
if (lid_matched[lid0] || (gid1>=my0 && gid1<Iend && lid_matched[gid1-my0])) {
continue;
}
/* skip if ghost vertex is done */
if (cpid1 != -1 && cpcol_matched[cpid1]) {
continue;
}
nactive_edges++;
/* skip if I have a bigger edge someplace (lid_max_ew gets updated) */
if (PetscRealPart(lid_max_ew[lid0]) > e->weight + 1.e-12) {
continue;
}
if (cpid1 == -1) {
if (PetscRealPart(lid_max_ew[lid1]) > e->weight + 1.e-12) {
continue;
}
} else {
/* see if edge might get matched on other proc */
PetscReal g_max_e = PetscRealPart(cpcol_max_ew[cpid1]);
if (g_max_e > e->weight + 1.e-12) {
continue;
} else if (e->weight > g_max_e - 1.e-12 && (PetscMPIInt)PetscRealPart(cpcol_max_pe[cpid1]) > rank) {
/* check for max_e == to this edge and larger processor that will deal with this */
continue;
}
}
/* check ghost for v0 */
if (isOK){
PetscReal max_e,ew;
if ((ix=lid_cprowID[lid0]) != -1) { /* if I have any ghost neighbors */
ii = matB->compressedrow.i; n = ii[ix+1] - ii[ix];
ap = matB->a + ii[ix];
idx = matB->j + ii[ix];
for (jj=0 ; jj<n && isOK; jj++) {
PetscInt lidj = idx[jj];
if (cpcol_matched[lidj]) continue;
ew = PetscRealPart(ap[jj]); max_e = PetscRealPart(cpcol_max_ew[lidj]);
/* check for max_e == to this edge and larger processor that will deal with this */
if (ew > max_e - 1.e-12 && ew > PetscRealPart(lid_max_ew[lid0]) - 1.e-12 && (PetscMPIInt)PetscRealPart(cpcol_max_pe[lidj]) > rank){
isOK = PETSC_FALSE;
}
}
}
/* for v1 */
if (cpid1 == -1 && isOK){
if ((ix=lid_cprowID[lid1]) != -1) { /* if I have any ghost neighbors */
ii = matB->compressedrow.i; n = ii[ix+1] - ii[ix];
ap = matB->a + ii[ix];
idx = matB->j + ii[ix];
for (jj=0 ; jj<n && isOK ; jj++) {
PetscInt lidj = idx[jj];
if (cpcol_matched[lidj]) continue;
ew = PetscRealPart(ap[jj]); max_e = PetscRealPart(cpcol_max_ew[lidj]);
/* check for max_e == to this edge and larger processor that will deal with this */
if (ew > max_e - 1.e-12 && ew > PetscRealPart(lid_max_ew[lid1]) - 1.e-12 && (PetscMPIInt)PetscRealPart(cpcol_max_pe[lidj]) > rank) {
isOK = PETSC_FALSE;
}
}
}
}
}
/* do it */
if (isOK){
if (cpid1 == -1) {
lid_matched[lid1] = PETSC_TRUE; /* keep track of what we've done this round */
ierr = PetscCDAppendRemove(agg_llists, lid0, lid1);CHKERRQ(ierr);
} else if (sub_it != n_sub_its-1) {
/* add gid1 to list of ghost deleted by me -- I need their children */
proc = cpcol_pe[cpid1];
cpcol_matched[cpid1] = PETSC_TRUE; /* messing with VecGetArray array -- needed??? */
ierr = PetscCDAppendID(deleted_list, proc, cpid1);CHKERRQ(ierr); /* cache to send messages */
ierr = PetscCDAppendID(deleted_list, proc, lid0);CHKERRQ(ierr);
} else {
continue;
}
lid_matched[lid0] = PETSC_TRUE; /* keep track of what we've done this round */
/* set projection */
ierr = MatSetValues(P,1,&gid0,1,&gid0,&one,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(P,1,&gid1,1,&gid0,&one,INSERT_VALUES);CHKERRQ(ierr);
} /* matched */
} /* edge loop */
/* deal with deleted ghost on first pass */
if (size>1 && sub_it != n_sub_its-1){
PetscCDPos pos; PetscBool ise = PETSC_FALSE;
PetscInt nSend1, **sbuffs1,nSend2;
#define REQ_BF_SIZE 100
MPI_Request *sreqs2[REQ_BF_SIZE],*rreqs2[REQ_BF_SIZE];
MPI_Status status;
/* send request */
for (proc=0,nSend1=0;proc<size;proc++){
ierr = PetscCDEmptyAt(deleted_list,proc,&ise);CHKERRQ(ierr);
if (!ise) nSend1++;
}
ierr = PetscMalloc(nSend1*sizeof(PetscInt*), &sbuffs1);CHKERRQ(ierr);
/* ierr = PetscMalloc4(nSend1, PetscInt*, sbuffs1, nSend1, PetscInt*, rbuffs1, nSend1, MPI_Request*, sreqs1, nSend1, MPI_Request*, rreqs1);CHKERRQ(ierr); */
/* PetscFree4(sbuffs1,rbuffs1,sreqs1,rreqs1); */
for (proc=0,nSend1=0;proc<size;proc++){
/* count ghosts */
ierr = PetscCDSizeAt(deleted_list,proc,&n);CHKERRQ(ierr);
if (n>0){
#define CHUNCK_SIZE 100
PetscInt *sbuff,*pt;
MPI_Request *request;
assert(n%2==0);
n /= 2;
ierr = PetscMalloc((2 + 2*n + n*CHUNCK_SIZE)*sizeof(PetscInt) + 2*sizeof(MPI_Request), &sbuff);CHKERRQ(ierr);
/* PetscMalloc4(2+2*n,PetscInt,sbuffs1[nSend1],n*CHUNCK_SIZE,PetscInt,rbuffs1[nSend1],1,MPI_Request,rreqs2[nSend1],1,MPI_Request,sreqs2[nSend1]); */
/* save requests */
sbuffs1[nSend1] = sbuff;
request = (MPI_Request*)sbuff;
sbuff = pt = (PetscInt*)(request+1);
*pt++ = n; *pt++ = rank;
ierr = PetscCDGetHeadPos(deleted_list,proc,&pos);CHKERRQ(ierr);
while(pos){
PetscInt lid0, cpid, gid;
ierr = PetscLLNGetID(pos, &cpid);CHKERRQ(ierr);
gid = (PetscInt)PetscRealPart(cpcol_gid[cpid]);
ierr = PetscCDGetNextPos(deleted_list,proc,&pos);CHKERRQ(ierr);
ierr = PetscLLNGetID(pos, &lid0);CHKERRQ(ierr);
ierr = PetscCDGetNextPos(deleted_list,proc,&pos);CHKERRQ(ierr);
*pt++ = gid; *pt++ = lid0;
}
/* send request tag1 [n, proc, n*[gid1,lid0] ] */
ierr = MPI_Isend(sbuff, 2*n+2, MPIU_INT, proc, tag1, wcomm, request);CHKERRQ(ierr);
/* post recieve */
request = (MPI_Request*)pt;
rreqs2[nSend1] = request; /* cache recv request */
pt = (PetscInt*)(request+1);
ierr = MPI_Irecv(pt, n*CHUNCK_SIZE, MPIU_INT, proc, tag2, wcomm, request);CHKERRQ(ierr);
/* clear list */
ierr = PetscCDRemoveAll(deleted_list, proc);CHKERRQ(ierr);
nSend1++;
}
}
/* recieve requests, send response, clear lists */
kk = nactive_edges;
ierr = MPI_Allreduce(&kk,&nactive_edges,1,MPIU_INT,MPI_SUM,wcomm);CHKERRQ(ierr); /* not correct syncronization and global */
nSend2 = 0;
while(1){
#define BF_SZ 10000
PetscMPIInt flag,count;
PetscInt rbuff[BF_SZ],*pt,*pt2,*pt3,count2,*sbuff,count3;
MPI_Request *request;
ierr = MPI_Iprobe(MPI_ANY_SOURCE, tag1, wcomm, &flag, &status);CHKERRQ(ierr);
if (!flag) break;
ierr = MPI_Get_count(&status, MPIU_INT, &count);CHKERRQ(ierr);
if (count > BF_SZ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"buffer too small for recieve: %d",count);
proc = status.MPI_SOURCE;
/* recieve request tag1 [n, proc, n*[gid1,lid0] ] */
ierr = MPI_Recv(rbuff, count, MPIU_INT, proc, tag1, wcomm, &status);CHKERRQ(ierr);
/* count sends */
pt = rbuff; count3 = count2 = 0;
n = *pt++; kk = *pt++; assert(kk==proc);
while(n--){
PetscInt gid1=*pt++, lid1=gid1-my0; kk=*pt++; assert(lid1>=0 && lid1<nloc);
if (lid_matched[lid1]){
PetscPrintf(PETSC_COMM_SELF,"\t *** [%d]%s %d) ERROR recieved deleted gid %d, deleted by (lid) %d from proc %d\n",rank,__FUNCT__,sub_it,gid1,kk);
PetscSleep(1);
}
assert(!lid_matched[lid1]);
lid_matched[lid1] = PETSC_TRUE; /* keep track of what we've done this round */
ierr = PetscCDSizeAt(agg_llists, lid1, &kk);CHKERRQ(ierr);
count2 += kk + 2;
count3++; /* number of verts requested (n) */
}
assert(pt-rbuff==count);
if (count2 > count3*CHUNCK_SIZE) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Irecv will be too small: %d",count2);
/* send tag2 *[lid0, n, n*[gid] ] */
ierr = PetscMalloc(count2*sizeof(PetscInt) + sizeof(MPI_Request), &sbuff);CHKERRQ(ierr);
request = (MPI_Request*)sbuff;
sreqs2[nSend2++] = request; /* cache request */
if (nSend2==REQ_BF_SIZE) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"buffer too small for requests: %d",nSend2);
pt2 = sbuff = (PetscInt*)(request+1);
pt = rbuff;
n = *pt++; kk = *pt++; assert(kk==proc);
while(n--){
/* read [n, proc, n*[gid1,lid0] */
PetscInt gid1=*pt++, lid1=gid1-my0, lid0=*pt++; assert(lid1>=0 && lid1<nloc);
/* write [lid0, n, n*[gid] ] */
*pt2++ = lid0;
pt3 = pt2++; /* save pointer for later */
/* for (pos=PetscCDGetHeadPos(agg_llists,lid1) ; pos ; pos=PetscCDGetNextPos(agg_llists,lid1,pos)){ */
ierr = PetscCDGetHeadPos(agg_llists,lid1,&pos);CHKERRQ(ierr);
while(pos){
PetscInt gid;
ierr = PetscLLNGetID(pos, &gid);CHKERRQ(ierr);
ierr = PetscCDGetNextPos(agg_llists,lid1,&pos);CHKERRQ(ierr);
*pt2++ = gid;
}
*pt3 = (pt2-pt3)-1;
/* clear list */
ierr = PetscCDRemoveAll(agg_llists, lid1);CHKERRQ(ierr);
}
assert(pt2-sbuff==count2); assert(pt-rbuff==count);
/* send requested data tag2 *[lid0, n, n*[gid1] ] */
ierr = MPI_Isend(sbuff, count2, MPIU_INT, proc, tag2, wcomm, request);CHKERRQ(ierr);
}
/* recieve tag2 *[lid0, n, n*[gid] ] */
for (kk=0;kk<nSend1;kk++){
PetscMPIInt count;
MPI_Request *request;
PetscInt *pt, *pt2;
request = rreqs2[kk]; /* no need to free -- buffer is in 'sbuffs1' */
ierr = MPI_Wait(request, &status);CHKERRQ(ierr);
ierr = MPI_Get_count(&status, MPIU_INT, &count);CHKERRQ(ierr);
pt = pt2 = (PetscInt*)(request+1);
while(pt-pt2 < count){
PetscInt lid0 = *pt++, n = *pt++; assert(lid0>=0 && lid0<nloc);
while(n--){
PetscInt gid1 = *pt++;
ierr = PetscCDAppendID(agg_llists, lid0, gid1);CHKERRQ(ierr);
}
}
assert(pt-pt2==count);
}
/* wait for tag1 isends */
while(nSend1--){
MPI_Request *request;
request = (MPI_Request*)sbuffs1[nSend1];
ierr = MPI_Wait(request, &status);CHKERRQ(ierr);
ierr = PetscFree(request);CHKERRQ(ierr);
}
ierr = PetscFree(sbuffs1);CHKERRQ(ierr);
/* wait for tag2 isends */
while(nSend2--){
MPI_Request *request = sreqs2[nSend2];
ierr = MPI_Wait(request, &status);CHKERRQ(ierr);
ierr = PetscFree(request);CHKERRQ(ierr);
}
ierr = VecRestoreArray(ghostMaxEdge, &cpcol_max_ew);CHKERRQ(ierr);
ierr = VecRestoreArray(ghostMaxPE, &cpcol_max_pe);CHKERRQ(ierr);
/* get 'cpcol_matched' - use locMaxPE, ghostMaxEdge, cpcol_max_ew */
for (kk=0,gid=my0;kk<nloc;kk++,gid++) {
PetscScalar vval = lid_matched[kk] ? 1.0 : 0.0;
ierr = VecSetValues(locMaxPE, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr); /* set with GID */
}
ierr = VecAssemblyBegin(locMaxPE);CHKERRQ(ierr);
ierr = VecAssemblyEnd(locMaxPE);CHKERRQ(ierr);
ierr = VecScatterBegin(mpimat->Mvctx,locMaxPE,ghostMaxEdge,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(mpimat->Mvctx,locMaxPE,ghostMaxEdge,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecGetArray(ghostMaxEdge, &cpcol_max_ew);CHKERRQ(ierr);
ierr = VecGetLocalSize(mpimat->lvec, &n);CHKERRQ(ierr);
for (kk=0;kk<n;kk++) {
cpcol_matched[kk] = (PetscBool)(PetscRealPart(cpcol_max_ew[kk]) != 0.0);
}
ierr = VecRestoreArray(ghostMaxEdge, &cpcol_max_ew);CHKERRQ(ierr);
} /* size > 1 */
/* compute 'locMaxEdge' */
ierr = VecRestoreArray(locMaxEdge, &lid_max_ew);CHKERRQ(ierr);
for (kk=0,gid=my0;kk<nloc;kk++,gid++){
PetscReal max_e = 0.,tt;
PetscScalar vval;
PetscInt lid = kk;
if (lid_matched[lid]) vval = 0.;
else {
ii = matA->i; n = ii[lid+1] - ii[lid]; idx = matA->j + ii[lid];
ap = matA->a + ii[lid];
for (jj=0; jj<n; jj++) {
PetscInt lidj = idx[jj];
if (lid_matched[lidj]) continue; /* this is new - can change local max */
if (lidj != lid && PetscRealPart(ap[jj]) > max_e) max_e = PetscRealPart(ap[jj]);
}
if (lid_cprowID && (ix=lid_cprowID[lid]) != -1) { /* if I have any ghost neighbors */
ii = matB->compressedrow.i; n = ii[ix+1] - ii[ix];
ap = matB->a + ii[ix];
idx = matB->j + ii[ix];
for (jj=0 ; jj<n ; jj++) {
PetscInt lidj = idx[jj];
if (cpcol_matched[lidj]) continue;
if ((tt=PetscRealPart(ap[jj])) > max_e) max_e = tt;
}
}
}
vval = (PetscScalar)max_e;
ierr = VecSetValues(locMaxEdge, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr); /* set with GID */
}
ierr = VecAssemblyBegin(locMaxEdge);CHKERRQ(ierr);
ierr = VecAssemblyEnd(locMaxEdge);CHKERRQ(ierr);
if (size>1 && sub_it != n_sub_its-1){
/* compute 'cpcol_max_ew' */
ierr = VecScatterBegin(mpimat->Mvctx,locMaxEdge,ghostMaxEdge,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(mpimat->Mvctx,locMaxEdge,ghostMaxEdge,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecGetArray(ghostMaxEdge, &cpcol_max_ew);CHKERRQ(ierr);
ierr = VecGetArray(locMaxEdge, &lid_max_ew);CHKERRQ(ierr);
/* compute 'cpcol_max_pe' */
for (kk=0,gid=my0;kk<nloc;kk++,gid++){
PetscInt lid = kk;
PetscReal ew,v1_max_e,v0_max_e=PetscRealPart(lid_max_ew[lid]);
PetscScalar vval;
PetscMPIInt max_pe=rank,pe;
if (lid_matched[lid]) vval = (PetscScalar)rank;
else if ((ix=lid_cprowID[lid]) != -1) { /* if I have any ghost neighbors */
ii = matB->compressedrow.i; n = ii[ix+1] - ii[ix];
ap = matB->a + ii[ix];
idx = matB->j + ii[ix];
for (jj=0 ; jj<n ; jj++) {
PetscInt lidj = idx[jj];
if (cpcol_matched[lidj]) continue;
ew = PetscRealPart(ap[jj]); v1_max_e = PetscRealPart(cpcol_max_ew[lidj]);
/* get max pe that has a max_e == to this edge w */
if ((pe=cpcol_pe[idx[jj]]) > max_pe && ew > v1_max_e - 1.e-12 && ew > v0_max_e - 1.e-12) max_pe = pe;
assert(ew < v0_max_e + 1.e-12 && ew < v1_max_e + 1.e-12);
}
vval = (PetscScalar)max_pe;
}
ierr = VecSetValues(locMaxPE, 1, &gid, &vval, INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(locMaxPE);CHKERRQ(ierr);
ierr = VecAssemblyEnd(locMaxPE);CHKERRQ(ierr);
ierr = VecScatterBegin(mpimat->Mvctx,locMaxPE,ghostMaxPE,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(mpimat->Mvctx,locMaxPE,ghostMaxPE,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecGetArray(ghostMaxPE, &cpcol_max_pe);CHKERRQ(ierr);
ierr = VecRestoreArray(locMaxEdge, &lid_max_ew);CHKERRQ(ierr);
} /* deal with deleted ghost */
if (verbose>2) PetscPrintf(wcomm,"\t[%d]%s %d.%d: %d active edges.\n",
rank,__FUNCT__,iter,sub_it,nactive_edges);
if (!nactive_edges) break;
} /* sub_it loop */
/* clean up iteration */
ierr = PetscFree(Edges);CHKERRQ(ierr);
if (mpimat){
ierr = VecRestoreArray(ghostMaxEdge, &cpcol_max_ew);CHKERRQ(ierr);
ierr = VecDestroy(&ghostMaxEdge);CHKERRQ(ierr);
ierr = VecRestoreArray(ghostMaxPE, &cpcol_max_pe);CHKERRQ(ierr);
ierr = VecDestroy(&ghostMaxPE);CHKERRQ(ierr);
ierr = PetscFree(cpcol_pe);CHKERRQ(ierr);
ierr = PetscFree(cpcol_matched);CHKERRQ(ierr);
}
ierr = VecDestroy(&locMaxEdge);CHKERRQ(ierr);
ierr = VecDestroy(&locMaxPE);CHKERRQ(ierr);
if (mpimat){
ierr = VecRestoreArray(mpimat->lvec, &cpcol_gid);CHKERRQ(ierr);
}
/* create next G if needed */
if (iter == n_iter) { /* hard wired test - need to look at full surrounded nodes or something */
ierr = MatDestroy(&P);CHKERRQ(ierr);
ierr = MatDestroy(&cMat);CHKERRQ(ierr);
break;
} else {
Vec diag;
/* add identity for unmatched vertices so they stay alive */
for (kk=0,gid=my0;kk<nloc;kk++,gid++){
if (!lid_matched[kk]) {
gid = kk+my0;
ierr = MatGetRow(cMat,gid,&n,0,0);CHKERRQ(ierr);
if (n>1){
ierr = MatSetValues(P,1,&gid,1,&gid,&one,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatRestoreRow(cMat,gid,&n,0,0);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(P,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(P,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* project to make new graph with colapsed edges */
ierr = MatPtAP(cMat,P,MAT_INITIAL_MATRIX,1.0,&tMat);CHKERRQ(ierr);
ierr = MatDestroy(&P);CHKERRQ(ierr);
ierr = MatDestroy(&cMat);CHKERRQ(ierr);
cMat = tMat;
ierr = MatGetVecs(cMat, &diag, 0);CHKERRQ(ierr);
ierr = MatGetDiagonal(cMat, diag);CHKERRQ(ierr); /* effectively PCJACOBI */
ierr = VecReciprocal(diag);CHKERRQ(ierr);
ierr = VecSqrtAbs(diag);CHKERRQ(ierr);
ierr = MatDiagonalScale(cMat, diag, diag);CHKERRQ(ierr);
ierr = VecDestroy(&diag);CHKERRQ(ierr);
}
} /* coarsen iterator */
/* make fake matrix */
if (size>1){
Mat mat;
PetscCDPos pos;
PetscInt gid, NN, MM, jj = 0, mxsz = 0;
for (kk=0;kk<nloc;kk++){
ierr = PetscCDSizeAt(agg_llists, kk, &jj);CHKERRQ(ierr);
if (jj > mxsz) mxsz = jj;
}
ierr = MatGetSize(a_Gmat, &MM, &NN);CHKERRQ(ierr);
if (mxsz > MM-nloc) mxsz = MM-nloc;
ierr = MatCreateAIJ(wcomm, nloc, nloc,PETSC_DETERMINE, PETSC_DETERMINE,0, 0, mxsz, 0, &mat);CHKERRQ(ierr);
/* */
for (kk=0,gid=my0;kk<nloc;kk++,gid++){
/* for (pos=PetscCDGetHeadPos(agg_llists,kk) ; pos ; pos=PetscCDGetNextPos(agg_llists,kk,pos)){ */
ierr = PetscCDGetHeadPos(agg_llists,kk,&pos);CHKERRQ(ierr);
while(pos){
PetscInt gid1;
ierr = PetscLLNGetID(pos, &gid1);CHKERRQ(ierr);
ierr = PetscCDGetNextPos(agg_llists,kk,&pos);CHKERRQ(ierr);
if (gid1 < my0 || gid1 >= my0+nloc) {
ierr = MatSetValues(mat,1,&gid,1,&gid1,&one,ADD_VALUES);CHKERRQ(ierr);
}
}
}
ierr = MatAssemblyBegin(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscCDSetMat(agg_llists, mat);CHKERRQ(ierr);
}
ierr = PetscFree(lid_cprowID);CHKERRQ(ierr);
ierr = PetscFree(lid_gid);CHKERRQ(ierr);
ierr = PetscFree(lid_matched);CHKERRQ(ierr);
ierr = PetscCDDestroy(deleted_list);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
SNESComputeJacobianDefault - Computes the Jacobian using finite differences.
Collective on SNES
Input Parameters:
+ x1 - compute Jacobian at this point
- ctx - application's function context, as set with SNESSetFunction()
Output Parameters:
+ J - Jacobian matrix (not altered in this routine)
- B - newly computed Jacobian matrix to use with preconditioner (generally the same as J)
Options Database Key:
+ -snes_fd - Activates SNESComputeJacobianDefault()
. -snes_test_err - Square root of function error tolerance, default square root of machine
epsilon (1.e-8 in double, 3.e-4 in single)
- -mat_fd_type - Either wp or ds (see MATMFFD_WP or MATMFFD_DS)
Notes:
This routine is slow and expensive, and is not currently optimized
to take advantage of sparsity in the problem. Although
SNESComputeJacobianDefault() is not recommended for general use
in large-scale applications, It can be useful in checking the
correctness of a user-provided Jacobian.
An alternative routine that uses coloring to exploit matrix sparsity is
SNESComputeJacobianDefaultColor().
Level: intermediate
.keywords: SNES, finite differences, Jacobian
.seealso: SNESSetJacobian(), SNESComputeJacobianDefaultColor(), MatCreateSNESMF()
@*/
PetscErrorCode SNESComputeJacobianDefault(SNES snes,Vec x1,Mat J,Mat B,void *ctx)
{
Vec j1a,j2a,x2;
PetscErrorCode ierr;
PetscInt i,N,start,end,j,value,root;
PetscScalar dx,*y,wscale;
const PetscScalar *xx;
PetscReal amax,epsilon = PETSC_SQRT_MACHINE_EPSILON;
PetscReal dx_min = 1.e-16,dx_par = 1.e-1,unorm;
MPI_Comm comm;
PetscBool assembled,use_wp = PETSC_TRUE,flg;
const char *list[2] = {"ds","wp"};
PetscMPIInt size;
const PetscInt *ranges;
PetscFunctionBegin;
/* Since this Jacobian will possibly have "extra" nonzero locations just turn off errors for these locations */
ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(((PetscObject)snes)->prefix,"-snes_test_err",&epsilon,0);CHKERRQ(ierr);
ierr = PetscObjectGetComm((PetscObject)x1,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MatAssembled(B,&assembled);CHKERRQ(ierr);
if (assembled) {
ierr = MatZeroEntries(B);CHKERRQ(ierr);
}
if (!snes->nvwork) {
snes->nvwork = 3;
ierr = VecDuplicateVecs(x1,snes->nvwork,&snes->vwork);CHKERRQ(ierr);
ierr = PetscLogObjectParents(snes,snes->nvwork,snes->vwork);CHKERRQ(ierr);
}
j1a = snes->vwork[0]; j2a = snes->vwork[1]; x2 = snes->vwork[2];
ierr = VecGetSize(x1,&N);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(x1,&start,&end);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,x1,j1a);CHKERRQ(ierr);
ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)snes),((PetscObject)snes)->prefix,"Differencing options","SNES");CHKERRQ(ierr);
ierr = PetscOptionsEList("-mat_fd_type","Algorithm to compute difference parameter","SNESComputeJacobianDefault",list,2,"wp",&value,&flg);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
if (flg && !value) use_wp = PETSC_FALSE;
if (use_wp) {
ierr = VecNorm(x1,NORM_2,&unorm);CHKERRQ(ierr);
}
/* Compute Jacobian approximation, 1 column at a time.
x1 = current iterate, j1a = F(x1)
x2 = perturbed iterate, j2a = F(x2)
*/
for (i=0; i<N; i++) {
ierr = VecCopy(x1,x2);CHKERRQ(ierr);
if (i>= start && i<end) {
ierr = VecGetArrayRead(x1,&xx);CHKERRQ(ierr);
if (use_wp) dx = PetscSqrtReal(1.0 + unorm);
else dx = xx[i-start];
ierr = VecRestoreArrayRead(x1,&xx);CHKERRQ(ierr);
if (PetscAbsScalar(dx) < dx_min) dx = (PetscRealPart(dx) < 0. ? -1. : 1.) * dx_par;
dx *= epsilon;
wscale = 1.0/dx;
ierr = VecSetValues(x2,1,&i,&dx,ADD_VALUES);CHKERRQ(ierr);
} else {
wscale = 0.0;
}
ierr = VecAssemblyBegin(x2);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x2);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,x2,j2a);CHKERRQ(ierr);
ierr = VecAXPY(j2a,-1.0,j1a);CHKERRQ(ierr);
/* Communicate scale=1/dx_i to all processors */
ierr = VecGetOwnershipRanges(x1,&ranges);CHKERRQ(ierr);
root = size;
for (j=size-1; j>-1; j--) {
root--;
if (i>=ranges[j]) break;
}
ierr = MPI_Bcast(&wscale,1,MPIU_SCALAR,root,comm);CHKERRQ(ierr);
ierr = VecScale(j2a,wscale);CHKERRQ(ierr);
ierr = VecNorm(j2a,NORM_INFINITY,&amax);CHKERRQ(ierr); amax *= 1.e-14;
ierr = VecGetArray(j2a,&y);CHKERRQ(ierr);
for (j=start; j<end; j++) {
if (PetscAbsScalar(y[j-start]) > amax || j == i) {
ierr = MatSetValues(B,1,&j,1,&i,y+j-start,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecRestoreArray(j2a,&y);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (B != J) {
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/* Evaluate analytical Jacobian matrix.
When debugging Jacobian:
./marine -noscale -dx 60000 -mat_view -exactinit |tail -n 18
versus
./marine -noscale -dx 60000 -mat_view -exactinit -snes_fd |tail -n 18
and do
./marine -noscale -dx 60000 -snes_type test
./marine -noscale -dx 60000 -snes_type test -snes_test_display
*/
PetscErrorCode JacobianMatrixLocal(DMDALocalInfo *info, Node *Hu,
Mat A, Mat jac, MatStructure *str, AppCtx *user)
{
PetscErrorCode ierr;
PetscReal rg = user->rho * user->g,
dx = user->dx,
Hg = user->zocean * (user->rhow / user->rho);
PetscReal *Bstag, Hl, ul, Fl, Fr, Gl, Gr, hr, hl;
PetscInt i, Mx = info->mx;
Vec locBstag;
PetscReal v[6];
MatStencil row,col[6];
PetscFunctionBegin;
ierr = DMGetLocalVector(user->stagda,&locBstag);CHKERRQ(ierr); /* do NOT destroy it */
ierr = DMGlobalToLocalBegin(user->stagda,user->Bstag,INSERT_VALUES,locBstag); CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(user->stagda,user->Bstag,INSERT_VALUES,locBstag); CHKERRQ(ierr);
ierr = DMDAVecGetArray(user->stagda,locBstag,&Bstag);CHKERRQ(ierr);
for (i=info->xs; i<info->xs+info->xm; i++) {
/* MASS CONT */
row.i = i; row.c = 0; /* "row.c=0" means H component of f */
if (i == 0) {
col[0].i = i; col[0].c = 0; v[0] = 1.0;
ierr = MatSetValuesStencil(jac,1,&row,1,col,v,INSERT_VALUES);CHKERRQ(ierr);
} else {
col[0].i = i; col[0].c = 0; v[0] = Hu[i].u / dx;
col[1].i = i; col[1].c = 1; v[1] = Hu[i].H / dx;
if (i > 1) {
col[2].i = i-1; col[2].c = 0; v[2] = - Hu[i-1].u / dx;
col[3].i = i-1; col[3].c = 1; v[3] = - Hu[i-1].H / dx;
}
ierr = MatSetValuesStencil(jac,1,&row,(i > 1) ? 4 : 2,col,v,INSERT_VALUES);CHKERRQ(ierr);
} /* done with MASS CONT */
/* SSA */
row.i = i; row.c = 1; /* "row.c=1" means u component of f */
if (i == 0) {
col[0].i = i; col[0].c = 1; v[0] = 1.0;
ierr = MatSetValuesStencil(jac,1,&row,1,col,v,INSERT_VALUES);CHKERRQ(ierr);
} else if (i == Mx - 1) {
col[0].i = i-1; col[0].c = 0; v[0] = 0.25 * user->omega * rg;
col[1].i = i; col[1].c = 0; v[1] = 0.25 * user->omega * rg;
Gl = GSR(dx,user->epsilon,user->n,Hu[i-1].u,Hu[i].u);
col[2].i = i-1; col[2].c = 1; v[2] = 2.0 * Bstag[i-1] * Gl / dx;
col[3].i = i; col[3].c = 1; v[3] = - 2.0 * Bstag[i-1] * Gl / dx;
ierr = MatSetValuesStencil(jac,1,&row,4,col,v,INSERT_VALUES);CHKERRQ(ierr);
} else {
ul = (i == 1) ? user->ua : Hu[i-1].u;
Hl = (i == 1) ? user->Ha : Hu[i-1].H;
Fl = GetFSR(dx,user->epsilon,user->n,ul,Hu[i].u);
Fr = GetFSR(dx,user->epsilon,user->n,Hu[i].u,Hu[i+1].u);
Gl = GSR(dx,user->epsilon,user->n,ul,Hu[i].u);
Gr = GSR(dx,user->epsilon,user->n,Hu[i].u,Hu[i+1].u);
// df^u / dH
col[0].i = i-1; col[0].c = 0;
if (i == 1)
v[0] = 0.0;
else {
v[0] = ( - Bstag[i-1] * Fl ) / dx
- rg * Hu[i].H * ( - dsurfdH(Hl,Hg,user->omega,0.0) ) / (2.0 * dx);
}
col[1].i = i; col[1].c = 0;
hl = getsurf(Hl,Hg,user->omega,user->zocean,0.0);
hr = getsurf(Hu[i+1].H,Hg,user->omega,user->zocean,0.0);
v[1] = ( Bstag[i] * Fr - Bstag[i-1] * Fl ) / dx
- user->k * rg * GLREG(Hu[i].H,Hg,0.0) * Hu[i].u
- rg * (hr - hl) / (2.0 * dx);
col[2].i = i+1; col[2].c = 0;
v[2] = ( Bstag[i] * Fr ) / dx
- rg * Hu[i].H * ( dsurfdH(Hu[i+1].H,Hg,user->omega,0.0) ) / (2.0 * dx);
// df^u / du
col[3].i = i-1; col[3].c = 1;
v[3] = ( - Bstag[i-1] * (Hl + Hu[i].H) * (-1.0/dx) * Gl ) / dx;
col[4].i = i; col[4].c = 1;
v[4] = ( Bstag[i] * (Hu[i].H + Hu[i+1].H) * (-1.0/dx) * Gr
- Bstag[i-1] * (Hl + Hu[i].H) * (1.0/dx) * Gl ) / dx
- user->k * rg * Hu[i].H * GLREG(Hu[i].H,Hg,0.0);
col[5].i = i+1; col[5].c = 1;
v[5] = ( Bstag[i] * (Hu[i].H + Hu[i+1].H) * (1.0/dx) * Gr ) / dx;
ierr = MatSetValuesStencil(jac,1,&row,6,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = DMDAVecRestoreArray(user->stagda,locBstag,&Bstag);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(user->stagda,&locBstag);CHKERRQ(ierr);
/* assemble matrix, using the 2-step process */
ierr = MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (A != jac) {
ierr = MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
*str = SAME_NONZERO_PATTERN;
/* tell matrix we will never add a new nonzero location; if we do then gives error */
ierr = MatSetOption(jac,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
Mat A; /* operator matrix */
Vec u,v; /* left and right singular vectors */
SVD svd; /* singular value problem solver context */
SVDType type;
PetscReal error,tol,sigma,mu=PETSC_SQRT_MACHINE_EPSILON;
PetscInt n=100,i,j,Istart,Iend,nsv,maxit,its,nconv;
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-mu",&mu,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nLauchli singular value decomposition, (%D x %D) mu=%g\n\n",n+1,n,(double)mu);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Build the Lauchli matrix
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n+1,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
for (i=Istart;i<Iend;i++) {
if (i == 0) {
for (j=0;j<n;j++) {
ierr = MatSetValue(A,0,j,1.0,INSERT_VALUES);CHKERRQ(ierr);
}
} else {
ierr = MatSetValue(A,i,i-1,mu,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatGetVecs(A,&v,&u);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the singular value solver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create singular value solver context
*/
ierr = SVDCreate(PETSC_COMM_WORLD,&svd);CHKERRQ(ierr);
/*
Set operator
*/
ierr = SVDSetOperator(svd,A);CHKERRQ(ierr);
/*
Use thick-restart Lanczos as default solver
*/
ierr = SVDSetType(svd,SVDTRLANCZOS);CHKERRQ(ierr);
/*
Set solver parameters at runtime
*/
ierr = SVDSetFromOptions(svd);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the singular value system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = SVDSolve(svd);CHKERRQ(ierr);
ierr = SVDGetIterationNumber(svd,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %D\n",its);CHKERRQ(ierr);
/*
Optional: Get some information from the solver and display it
*/
ierr = SVDGetType(svd,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Solution method: %s\n\n",type);CHKERRQ(ierr);
ierr = SVDGetDimensions(svd,&nsv,NULL,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of requested singular values: %D\n",nsv);CHKERRQ(ierr);
ierr = SVDGetTolerances(svd,&tol,&maxit);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Stopping condition: tol=%.4g, maxit=%D\n",(double)tol,maxit);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Get number of converged singular triplets
*/
ierr = SVDGetConverged(svd,&nconv);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of converged approximate singular triplets: %D\n\n",nconv);CHKERRQ(ierr);
if (nconv>0) {
/*
Display singular values and relative errors
*/
ierr = PetscPrintf(PETSC_COMM_WORLD,
" sigma relative error\n"
" --------------------- ------------------\n");CHKERRQ(ierr);
for (i=0;i<nconv;i++) {
/*
Get converged singular triplets: i-th singular value is stored in sigma
*/
ierr = SVDGetSingularTriplet(svd,i,&sigma,u,v);CHKERRQ(ierr);
/*
Compute the error associated to each singular triplet
*/
ierr = SVDComputeRelativeError(svd,i,&error);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," % 6f ",(double)sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," % 12g\n",(double)error);CHKERRQ(ierr);
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n");CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = SVDDestroy(&svd);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&v);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
int main(int argc,char **args)
{
Mat A,LU;
Vec x,y;
PetscInt nnz[4]={2,1,1,1},col[4],i;
PetscErrorCode ierr;
PetscScalar values[4];
IS rowperm,colperm;
PetscInitialize(&argc,&args,(char*)0,help);
ierr = MatCreateSeqAIJ(PETSC_COMM_WORLD,4,4,2,nnz,&A);CHKERRQ(ierr);
/* build test matrix */
values[0]=1.0;values[1]=-1.0;
col[0] =0;col[1]=2; i=0;
ierr = MatSetValues(A,1,&i,2,col,values,INSERT_VALUES);CHKERRQ(ierr);
values[0]=1.0;
col[0] =1;i=1;
ierr = MatSetValues(A,1,&i,1,col,values,INSERT_VALUES);CHKERRQ(ierr);
values[0]=-1.0;
col[0] =3;i=2;
ierr = MatSetValues(A,1,&i,1,col,values,INSERT_VALUES);CHKERRQ(ierr);
values[0]=1.0;
col[0] =2;i=3;
ierr = MatSetValues(A,1,&i,1,col,values,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
ierr = MatGetOrdering(A,MATORDERINGNATURAL,&rowperm,&colperm);CHKERRQ(ierr);
ierr = MatReorderForNonzeroDiagonal(A,1.e-12,rowperm,colperm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"column and row perms\n");CHKERRQ(ierr);
ierr = ISView(rowperm,0);CHKERRQ(ierr);
ierr = ISView(colperm,0);CHKERRQ(ierr);
ierr = MatGetFactor(A,MATSOLVERPETSC,MAT_FACTOR_LU,&LU);CHKERRQ(ierr);
ierr = MatLUFactorSymbolic(LU,A,rowperm,colperm,NULL);CHKERRQ(ierr);
ierr = MatLUFactorNumeric(LU,A,NULL);CHKERRQ(ierr);
ierr = MatView(LU,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr);
ierr = VecSetSizes(x,PETSC_DECIDE,4);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&y);CHKERRQ(ierr);
values[0]=0;values[1]=1.0;values[2]=-1.0;values[3]=1.0;
for (i=0; i<4; i++) col[i]=i;
ierr = VecSetValues(x,4,col,values,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(x);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x);CHKERRQ(ierr);
ierr = VecView(x,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
ierr = MatSolve(LU,x,y);CHKERRQ(ierr);
ierr = VecView(y,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
ierr = ISDestroy(&rowperm);CHKERRQ(ierr);
ierr = ISDestroy(&colperm);CHKERRQ(ierr);
ierr = MatDestroy(&LU);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&y);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
PetscErrorCode MatApplyPAPt_Numeric_SeqAIJ_SeqAIJ(Mat A,Mat P,Mat C)
{
PetscErrorCode ierr;
PetscInt flops=0;
Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data;
Mat_SeqAIJ *p = (Mat_SeqAIJ *) P->data;
Mat_SeqAIJ *c = (Mat_SeqAIJ *) C->data;
PetscInt *ai=a->i,*aj=a->j,*ajj,*pi=p->i,*pj=p->j,*pjj=p->j,*paj,*pajdense,*ptj;
PetscInt *ci=c->i,*cj=c->j;
PetscInt an=A->cmap->N,am=A->rmap->N,pn=P->cmap->N,pm=P->rmap->N,cn=C->cmap->N,cm=C->rmap->N;
PetscInt i,j,k,k1,k2,pnzi,anzj,panzj,arow,ptcol,ptnzj,cnzi;
MatScalar *aa=a->a,*pa=p->a,*pta=p->a,*ptaj,*paa,*aaj,*ca=c->a,sum;
PetscFunctionBegin;
/* This error checking should be unnecessary if the symbolic was performed */
if (pm!=cm) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Matrix dimensions are incompatible, %D != %D",pm,cm);
if (pn!=am) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Matrix dimensions are incompatible, %D != %D",pn,am);
if (am!=an) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Matrix 'A' must be square, %D != %D",am, an);
if (pm!=cn) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Matrix dimensions are incompatible, %D != %D",pm, cn);
/* Set up timers */
ierr = PetscLogEventBegin(MAT_Applypapt_numeric,A,P,C,0);CHKERRQ(ierr);
ierr = PetscMemzero(ca,ci[cm]*sizeof(MatScalar));CHKERRQ(ierr);
ierr = PetscMalloc3(an,MatScalar,&paa,an,PetscInt,&paj,an,PetscInt,&pajdense);CHKERRQ(ierr);
ierr = PetscMemzero(paa,an*(sizeof(MatScalar)+2*sizeof(PetscInt)));CHKERRQ(ierr);
for (i=0;i<pm;i++) {
/* Form sparse row of P*A */
pnzi = pi[i+1] - pi[i];
panzj = 0;
for (j=0;j<pnzi;j++) {
arow = *pj++;
anzj = ai[arow+1] - ai[arow];
ajj = aj + ai[arow];
aaj = aa + ai[arow];
for (k=0;k<anzj;k++) {
if (!pajdense[ajj[k]]) {
pajdense[ajj[k]] = -1;
paj[panzj++] = ajj[k];
}
paa[ajj[k]] += (*pa)*aaj[k];
}
flops += 2*anzj;
pa++;
}
/* Sort the j index array for quick sparse axpy. */
ierr = PetscSortInt(panzj,paj);CHKERRQ(ierr);
/* Compute P*A*P^T using sparse inner products. */
/* Take advantage of pre-computed (i,j) of C for locations of non-zeros. */
cnzi = ci[i+1] - ci[i];
for (j=0;j<cnzi;j++) {
/* Form sparse inner product of current row of P*A with (*cj++) col of P^T. */
ptcol = *cj++;
ptnzj = pi[ptcol+1] - pi[ptcol];
ptj = pjj + pi[ptcol];
ptaj = pta + pi[ptcol];
sum = 0.;
k1 = 0;
k2 = 0;
while ((k1<panzj) && (k2<ptnzj)) {
if (paj[k1]==ptj[k2]) {
sum += paa[paj[k1++]]*ptaj[k2++];
} else if (paj[k1] < ptj[k2]) {
k1++;
} else /* if (paj[k1] > ptj[k2]) */ {
k2++;
}
}
*ca++ = sum;
}
/* Zero the current row info for P*A */
for (j=0;j<panzj;j++) {
paa[paj[j]] = 0.;
pajdense[paj[j]] = 0;
}
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscFree3(paa,paj,pajdense);CHKERRQ(ierr);
ierr = PetscLogFlops(flops);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_Applypapt_numeric,A,P,C,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatMatMatMultNumeric_SeqAIJ_SeqAIJ_SeqDense(Mat R,Mat A,Mat B,Mat RAB,PetscScalar *work)
{
Mat_SeqAIJ *a=(Mat_SeqAIJ*)A->data,*r=(Mat_SeqAIJ*)R->data;
PetscErrorCode ierr;
PetscScalar *b,r1,r2,r3,r4,*b1,*b2,*b3,*b4;
MatScalar *aa,*ra;
PetscInt cn=B->cmap->n,bm=B->rmap->n,col,i,j,n,*ai=a->i,*aj,am=A->rmap->n;
PetscInt am2=2*am,am3=3*am,bm4=4*bm;
PetscScalar *d,*c,*c2,*c3,*c4;
PetscInt *rj,rm=R->rmap->n,dm=RAB->rmap->n,dn=RAB->cmap->n;
PetscInt rm2=2*rm,rm3=3*rm,colrm;
PetscFunctionBegin;
if (!dm || !dn) PetscFunctionReturn(0);
if (bm != A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Number columns in A %D not equal rows in B %D\n",A->cmap->n,bm);
if (am != R->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Number columns in R %D not equal rows in A %D\n",R->cmap->n,am);
if (R->rmap->n != RAB->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Number rows in RAB %D not equal rows in R %D\n",RAB->rmap->n,R->rmap->n);
if (B->cmap->n != RAB->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Number columns in RAB %D not equal columns in B %D\n",RAB->cmap->n,B->cmap->n);
ierr = MatDenseGetArray(B,&b);CHKERRQ(ierr);
ierr = MatDenseGetArray(RAB,&d);CHKERRQ(ierr);
b1 = b; b2 = b1 + bm; b3 = b2 + bm; b4 = b3 + bm;
c = work; c2 = c + am; c3 = c2 + am; c4 = c3 + am;
for (col=0; col<cn-4; col += 4){ /* over columns of C */
for (i=0; i<am; i++) { /* over rows of A in those columns */
r1 = r2 = r3 = r4 = 0.0;
n = ai[i+1] - ai[i];
aj = a->j + ai[i];
aa = a->a + ai[i];
for (j=0; j<n; j++) {
r1 += (*aa)*b1[*aj];
r2 += (*aa)*b2[*aj];
r3 += (*aa)*b3[*aj];
r4 += (*aa++)*b4[*aj++];
}
c[i] = r1;
c[am + i] = r2;
c[am2 + i] = r3;
c[am3 + i] = r4;
}
b1 += bm4;
b2 += bm4;
b3 += bm4;
b4 += bm4;
/* RAB[:,col] = R*C[:,col] */
colrm = col*rm;
for (i=0; i<rm; i++) { /* over rows of R in those columns */
r1 = r2 = r3 = r4 = 0.0;
n = r->i[i+1] - r->i[i];
rj = r->j + r->i[i];
ra = r->a + r->i[i];
for (j=0; j<n; j++) {
r1 += (*ra)*c[*rj];
r2 += (*ra)*c2[*rj];
r3 += (*ra)*c3[*rj];
r4 += (*ra++)*c4[*rj++];
}
d[colrm + i] = r1;
d[colrm + rm + i] = r2;
d[colrm + rm2 + i] = r3;
d[colrm + rm3 + i] = r4;
}
}
for (;col<cn; col++){ /* over extra columns of C */
for (i=0; i<am; i++) { /* over rows of A in those columns */
r1 = 0.0;
n = a->i[i+1] - a->i[i];
aj = a->j + a->i[i];
aa = a->a + a->i[i];
for (j=0; j<n; j++) {
r1 += (*aa++)*b1[*aj++];
}
c[i] = r1;
}
b1 += bm;
for (i=0; i<rm; i++) { /* over rows of R in those columns */
r1 = 0.0;
n = r->i[i+1] - r->i[i];
rj = r->j + r->i[i];
ra = r->a + r->i[i];
for (j=0; j<n; j++) {
r1 += (*ra++)*c[*rj++];
}
d[col*rm + i] = r1;
}
}
ierr = PetscLogFlops(cn*2.0*(a->nz + r->nz));CHKERRQ(ierr);
ierr = MatDenseRestoreArray(B,&b);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(RAB,&d);CHKERRQ(ierr);
ierr = MatAssemblyBegin(RAB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(RAB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(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(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_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,DIFFERENT_NONZERO_PATTERN);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,DIFFERENT_NONZERO_PATTERN);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,DIFFERENT_NONZERO_PATTERN);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;",res_norm);CHKERRQ(ierr);
}
if (err_norm > err_tol){
ierr = PetscPrintf(PETSC_COMM_WORLD," Error norm %G.\n",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;
}
PetscErrorCode ComputeMatrix(KSP ksp, Mat J,Mat jac, void *ctx)
{
UserContext *user = (UserContext*)ctx;
PetscErrorCode ierr;
PetscInt i,j,mx,my,xm,ym,xs,ys,num, numi, numj;
PetscScalar v[5],Hx,Hy,HydHx,HxdHy;
MatStencil row, col[5];
DM da;
PetscFunctionBeginUser;
ierr = KSPGetDM(ksp,&da);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,0,&mx,&my,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
Hx = 1.0 / (PetscReal)(mx);
Hy = 1.0 / (PetscReal)(my);
HxdHy = Hx/Hy;
HydHx = Hy/Hx;
ierr = DMDAGetCorners(da,&xs,&ys,0,&xm,&ym,0);CHKERRQ(ierr);
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
row.i = i; row.j = j;
if (i==0 || j==0 || i==mx-1 || j==my-1) {
if (user->bcType == DIRICHLET) {
v[0] = 2.0*(HxdHy + HydHx);
ierr = MatSetValuesStencil(jac,1,&row,1,&row,v,INSERT_VALUES);CHKERRQ(ierr);
SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Dirichlet boundary conditions not supported !\n");
} else if (user->bcType == NEUMANN) {
num = 0; numi=0; numj=0;
if (j!=0) {
v[num] = -HxdHy;
col[num].i = i;
col[num].j = j-1;
num++; numj++;
}
if (i!=0) {
v[num] = -HydHx;
col[num].i = i-1;
col[num].j = j;
num++; numi++;
}
if (i!=mx-1) {
v[num] = -HydHx;
col[num].i = i+1;
col[num].j = j;
num++; numi++;
}
if (j!=my-1) {
v[num] = -HxdHy;
col[num].i = i;
col[num].j = j+1;
num++; numj++;
}
v[num] = (PetscReal)(numj)*HxdHy + (PetscReal)(numi)*HydHx; col[num].i = i; col[num].j = j;
num++;
ierr = MatSetValuesStencil(jac,1,&row,num,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
} else {
v[0] = -HxdHy; col[0].i = i; col[0].j = j-1;
v[1] = -HydHx; col[1].i = i-1; col[1].j = j;
v[2] = 2.0*(HxdHy + HydHx); col[2].i = i; col[2].j = j;
v[3] = -HydHx; col[3].i = i+1; col[3].j = j;
v[4] = -HxdHy; col[4].i = i; col[4].j = j+1;
ierr = MatSetValuesStencil(jac,1,&row,5,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
ierr = MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (user->bcType == NEUMANN) {
MatNullSpace nullspace;
ierr = MatNullSpaceCreate(PETSC_COMM_WORLD,PETSC_TRUE,0,0,&nullspace);CHKERRQ(ierr);
ierr = MatSetNullSpace(J,nullspace);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nullspace);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
FormJacobian - Evaluates Jacobian matrix.
Input Parameters:
. snes - the SNES context
. x - input vector
. dummy - optional user-defined context (not used here)
Output Parameters:
. jac - Jacobian matrix
. B - optionally different preconditioning matrix
. flag - flag indicating matrix structure
*/
PetscErrorCode FormJacobian(SNES snes,Vec x,Mat jac,Mat B,void *ctx)
{
ApplicationCtx *user = (ApplicationCtx*) ctx;
PetscScalar *xx,d,A[3];
PetscErrorCode ierr;
PetscInt i,j[3],M,xs,xm;
DM da = user->da;
PetscFunctionBeginUser;
/*
Get pointer to vector data
*/
ierr = DMDAVecGetArrayRead(da,x,&xx);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
/*
Get range of locally owned matrix
*/
ierr = DMDAGetInfo(da,NULL,&M,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
/*
Determine starting and ending local indices for interior grid points.
Set Jacobian entries for boundary points.
*/
if (xs == 0) { /* left boundary */
i = 0; A[0] = 1.0;
ierr = MatSetValues(jac,1,&i,1,&i,A,INSERT_VALUES);CHKERRQ(ierr);
xs++;xm--;
}
if (xs+xm == M) { /* right boundary */
i = M-1;
A[0] = 1.0;
ierr = MatSetValues(jac,1,&i,1,&i,A,INSERT_VALUES);CHKERRQ(ierr);
xm--;
}
/*
Interior grid points
- Note that in this case we set all elements for a particular
row at once.
*/
d = 1.0/(user->h*user->h);
for (i=xs; i<xs+xm; i++) {
j[0] = i - 1; j[1] = i; j[2] = i + 1;
A[0] = A[2] = d; A[1] = -2.0*d + 2.0*xx[i];
ierr = MatSetValues(jac,1,&i,3,j,A,INSERT_VALUES);CHKERRQ(ierr);
}
/*
Assemble matrix, using the 2-step process:
MatAssemblyBegin(), MatAssemblyEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
Also, restore vector.
*/
ierr = MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = DMDAVecRestoreArrayRead(da,x,&xx);CHKERRQ(ierr);
ierr = MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
const int iM11=0, iM12=1, iL11=2, iL22=3, iL21=4, ix=5;
Mat M11,M12,L11,L22,L21; /* matrix */
Vec x,y; /* input and output vectors */
Vec omg1,omg2,omg3,omg4; /* temporary vectors for the operation y=Ax */
KSP ksp; /* linear solver context */
PetscViewer fd[5]; /* viewer */
char file[6][PETSC_MAX_PATH_LEN]; /* input file name */
PetscErrorCode ierr;
PetscInt M, N; /* number of rows and columns of the GLOBAL matrices (they should be the same) */
PetscInt m, n; /* number of rows and columns of the LOCAL matrices */
PetscInt istart, iend; /* ownership row range of the process using GLOBAL indexes */
PetscScalar one=1.0;
PetscMPIInt rank, size;
PetscBool flg[6];
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);
PetscPrintf(PETSC_COMM_WORLD, "Number of processes size=%d\n", size);
// ************ READ MATRICES AND VECTOR x FROM INPUT *****
// M11 and M12
ierr = PetscOptionsGetString(PETSC_NULL,"-m11",file[iM11],PETSC_MAX_PATH_LEN,&flg[iM11]);CHKERRQ(ierr);
ierr = PetscOptionsGetString(PETSC_NULL,"-m12",file[iM12],PETSC_MAX_PATH_LEN,&flg[iM12]);CHKERRQ(ierr);
// L11 L22 and L21
ierr = PetscOptionsGetString(PETSC_NULL,"-l11",file[iL11],PETSC_MAX_PATH_LEN,&flg[iL11]);CHKERRQ(ierr);
ierr = PetscOptionsGetString(PETSC_NULL,"-l22",file[iL22],PETSC_MAX_PATH_LEN,&flg[iL22]);CHKERRQ(ierr);
ierr = PetscOptionsGetString(PETSC_NULL,"-l21",file[iL21],PETSC_MAX_PATH_LEN,&flg[iL21]);CHKERRQ(ierr);
// All of the matrix have to be defined by the user.
// If the user don't specify none of them, it will generate laplacian matrices.
if (flg[iM11] && flg[iM12] && flg[iL11] && flg[iL22] && flg[iL21]){
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[iM11],FILE_MODE_READ,\
&fd[iM11]);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[iM12],FILE_MODE_READ,\
&fd[iM12]);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[iL11],FILE_MODE_READ,\
&fd[iL11]);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[iL22],FILE_MODE_READ,\
&fd[iL22]);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[iL21],FILE_MODE_READ,\
&fd[iL21]);CHKERRQ(ierr);
// Load the matrix and vector; then destroy the viewer.
// M11 and M12
ierr = MatCreate(PETSC_COMM_WORLD,&M11);CHKERRQ(ierr);
ierr = MatSetType(M11,MATAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(M11);CHKERRQ(ierr);
ierr = MatLoad(M11,fd[iM11]);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&M12);CHKERRQ(ierr);
ierr = MatSetType(M12,MATAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(M12);CHKERRQ(ierr);
ierr = MatLoad(M12,fd[iM12]);CHKERRQ(ierr);
// L11 L22 and L21
ierr = MatCreate(PETSC_COMM_WORLD,&L11);CHKERRQ(ierr);
ierr = MatSetType(L11,MATAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(L11);CHKERRQ(ierr);
ierr = MatLoad(L11,fd[iL11]);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&L22);CHKERRQ(ierr);
ierr = MatSetType(L22,MATAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(L22);CHKERRQ(ierr);
ierr = MatLoad(L22,fd[iL22]);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&L21);CHKERRQ(ierr);
ierr = MatSetType(L21,MATAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(L21);CHKERRQ(ierr);
ierr = MatLoad(L21,fd[iL21]);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&fd[iM11]);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&fd[iM12]);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&fd[iL11]);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&fd[iL22]);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&fd[iL21]);CHKERRQ(ierr);
}
else if(!flg[iM11] && !flg[iM12] && !flg[iL11] && !flg[iL22] && !flg[iL21]){
// ******************* CREATING FAKE MATRICES *****************
PetscInt i,col[3];
M = N = 100;
PetscScalar value[3];
ierr = MatCreate(PETSC_COMM_WORLD,&M11);CHKERRQ(ierr);
ierr = MatSetSizes(M11,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(M11);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&M12);CHKERRQ(ierr);
ierr = MatSetSizes(M12,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(M12);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&L11);CHKERRQ(ierr);
ierr = MatSetSizes(L11,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(L11);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&L22);CHKERRQ(ierr);
ierr = MatSetSizes(L22,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(L22);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&L21);CHKERRQ(ierr);
ierr = MatSetSizes(L21,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(L21);CHKERRQ(ierr);
// Set values for them
value[0] = -1.0; value[1] = 2.0; value[2] = -1.0;
for (i=1; i<M-1; i++) {
col[0] = i-1; col[1] = i; col[2] = i+1;
ierr = MatSetValues(M11,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(M12,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(L11,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(L22,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(L21,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
i = N - 1; col[0] = N - 2; col[1] = N - 1;
ierr = MatSetValues(M11,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(M12,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(L11,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(L22,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(L21,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(M11,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(M12,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(L11,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(L22,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(L21,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(M11,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(M11,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(M12,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(M12,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(L11,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(L11,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(L22,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(L22,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(L21,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(L21,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
// ******************** END CREATING FAKE MATRICES *************
}
else{
SETERRQ(PETSC_COMM_WORLD,1,"You must either indicate the ascii file for each matrix M11 M12 L11 L22 L21 using the option -m11 -m12 .... or without any of these options.");
PetscFinalize();
return 1;
}
// Get some information about the partitioning of the matrix
ierr = MatGetSize(M11,&M,&N);CHKERRQ(ierr);
printf("Global dimension of the matrix M11 M=%d N=%d\n",M,N);
ierr = MatGetLocalSize(M11,&m,&n);
printf("Local dimension of the matrix M11 m=%d n=%d\n",m,n);
ierr = MatGetOwnershipRange(M11,&istart,&iend);
printf("Ownership range of the rows for process %d istart=%d iend=%d\n",rank,istart,iend);
// Read vector x from input. If it's not specified by the user, the vector x will be a unitary vector.
ierr = PetscOptionsGetString(PETSC_NULL,"-x",file[ix],PETSC_MAX_PATH_LEN,&flg[ix]);CHKERRQ(ierr);
if(!flg[ix]){
ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr);
ierr = VecSetSizes(x,PETSC_DECIDE,M);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecSet(x,one);CHKERRQ(ierr);
/*ierr = VecAssemblyBegin(x);CHKERRQ(ierr);*/
/*ierr = VecAssemblyEnd(x);CHKERRQ(ierr);*/
}
else{
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,file[ix],FILE_MODE_READ,&fd[ix]);CHKERRQ(ierr);
ierr = VecLoad(x,fd[ix]);CHKERRQ(ierr);
}
ierr = PetscObjectSetName((PetscObject) x, "The input vector");CHKERRQ(ierr);
// ************ END READ MATRICES AND VECTOR x FROM INPUT *****
// Create the temporary vectors and y
ierr = VecDuplicate(x,&y);CHKERRQ(ierr);
ierr = VecDuplicate(x,&omg1);CHKERRQ(ierr);
ierr = VecDuplicate(x,&omg2);CHKERRQ(ierr);
ierr = VecDuplicate(x,&omg3);CHKERRQ(ierr);
ierr = VecDuplicate(x,&omg4);CHKERRQ(ierr);
// ****************** COMPUTE y=Ax *******************
// Set the Krylov object
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
// Set operators. Here the matrix that defines the linear system
// also serves as the preconditioning matrix.
ierr = KSPSetOperators(ksp,L22,L22,DIFFERENT_NONZERO_PATTERN);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);
// Multiplication y = A*x
// omg1 = M11*x
// omg2 = L21*x
// L22*omg3 = omg2
// omg4 = omg1 + M12*omg3
// L11*y = omg4
ierr = MatMult(M11, x, omg1);CHKERRQ(ierr);
ierr = MatMult(L21, x, omg2);CHKERRQ(ierr);
ierr = KSPSolve(ksp,omg2,omg3);CHKERRQ(ierr);
ierr = MatMult(M12, omg3, omg4);CHKERRQ(ierr);
ierr = VecAXPY(omg4, one, omg1);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,L11,L11,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = KSPSolve(ksp,omg4,y);CHKERRQ(ierr);
// ****************** END COMPUTE y=Ax **************************
/*ierr = VecView(y, PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);*/
PetscBool test = PETSC_FALSE;
ierr = PetscOptionsGetBool(PETSC_NULL,"-test",&test,PETSC_NULL);CHKERRQ(ierr);
if(test){
// ******************** TESTING *********************************
// the testing doesn't work if the number of process are more than one
// because the type of the matrices must be different from matmpiaij. Let's try matseqaij
Mat L11_inv, L22_inv, I;
Mat A;
Mat M11_d;
Vec y2;
PetscInt i;
PetscScalar val;
// Create identity matrix
ierr = MatCreate(PETSC_COMM_WORLD,&I);CHKERRQ(ierr);
ierr = MatSetType(I, MATDENSE);
ierr = MatSetSizes(I,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(I);CHKERRQ(ierr);
val = 1.0;
for (i=0; i<M; i++) {
ierr = MatSetValues(I,1,&i,1,&i,&val,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(I,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(I,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
// Create L11_inv
ierr = MatCreate(PETSC_COMM_WORLD,&L11_inv);CHKERRQ(ierr);
ierr = MatSetType(L11_inv, MATDENSE);
ierr = MatSetSizes(L11_inv,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(L11_inv);CHKERRQ(ierr);
ierr = MatAssemblyBegin(L11_inv,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(L11_inv,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
// Create L22_inv
ierr = MatCreate(PETSC_COMM_WORLD,&L22_inv);CHKERRQ(ierr);
ierr = MatSetType(L22_inv, MATDENSE);
ierr = MatSetSizes(L22_inv,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(L22_inv);CHKERRQ(ierr);
ierr = MatAssemblyBegin(L22_inv,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(L22_inv,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
// Create A
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
// Define M11_d
ierr = MatCreate(PETSC_COMM_WORLD,&M11_d);CHKERRQ(ierr);
ierr = MatSetType(M11_d, MATDENSE);
ierr = MatSetSizes(M11_d,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(M11_d);CHKERRQ(ierr);
ierr = MatAssemblyBegin(M11_d,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(M11_d,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
// Calculate A = L11^{-1}*(M11 + M12*L22^{-1}*L21)
IS perm, iperm;
MatFactorInfo info;
ierr = MatGetOrdering(L11,MATORDERINGNATURAL,&perm,&iperm);CHKERRQ(ierr);
ierr = MatFactorInfoInitialize(&info); CHKERRQ(ierr);
ierr = MatLUFactor(L11, perm, iperm, &info); CHKERRQ(ierr);
ierr = MatMatSolve(L11, I, L11_inv);CHKERRQ(ierr);
// TODO try to convert L11_inv to be sparse such as matseqaij
// ierr = MatView(L11_inv, PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
ierr = MatGetOrdering(L22,MATORDERINGNATURAL,&perm,&iperm);CHKERRQ(ierr);
ierr = MatFactorInfoInitialize(&info); CHKERRQ(ierr);
ierr = MatLUFactor(L22, perm, iperm, &info); CHKERRQ(ierr);
ierr = MatMatSolve(L22, I, L22_inv);CHKERRQ(ierr);
ierr = MatMatMult(M12, L22_inv, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &A);CHKERRQ(ierr);
ierr = MatMatMult(A, L21, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &A);CHKERRQ(ierr);
ierr = MatConvert(M11, MATDENSE, MAT_INITIAL_MATRIX, &M11_d);
ierr = MatAXPY(A,1.0,M11_d,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatMatMult(L11_inv, A, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &A);CHKERRQ(ierr);
ierr = VecDuplicate(x,&y2);CHKERRQ(ierr);
ierr = MatMult(A, x, y2);CHKERRQ(ierr);
/*ierr = VecView(y2, PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);*/
// Check the error
PetscReal norm;
ierr = VecAXPY(y2,-1.0,y);CHKERRQ(ierr);
ierr = VecNorm(y2,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %A\n",
norm);CHKERRQ(ierr);
// ******************** END TESTING *****************************
}
PetscFinalize();
return 0;
}
int main(int argc, char * argv[])
{
typedef MPI::HGeometryForest<DIM,DOW> forest_t;
typedef MPI::BirdView<forest_t> ir_mesh_t;
typedef FEMSpace<double,DIM,DOW> fe_space_t;
typedef MPI::DOF::GlobalIndex<forest_t, fe_space_t> global_index_t;
PetscInitialize(&argc, &argv, (char *)NULL, help);
forest_t forest(PETSC_COMM_WORLD);
forest.readMesh(argv[1]);
ir_mesh_t ir_mesh(forest);
int round = 0;
if (argc >= 3) round = atoi(argv[2]);
ir_mesh.globalRefine(round);
ir_mesh.semiregularize();
ir_mesh.regularize(false);
setenv("AFEPACK_TEMPLATE_PATH", "/usr/local/AFEPack/template/triangle", 1);
TemplateGeometry<DIM> tri;
tri.readData("triangle.tmp_geo");
CoordTransform<DIM,DIM> tri_ct;
tri_ct.readData("triangle.crd_trs");
TemplateDOF<DIM> tri_td(tri);
tri_td.readData("triangle.1.tmp_dof");
BasisFunctionAdmin<double,DIM,DIM> tri_bf(tri_td);
tri_bf.readData("triangle.1.bas_fun");
std::vector<TemplateElement<double,DIM,DIM> > tmp_ele(1);
tmp_ele[0].reinit(tri, tri_td, tri_ct, tri_bf);
RegularMesh<DIM,DOW>& mesh = ir_mesh.regularMesh();
fe_space_t fem_space(mesh, tmp_ele);
u_int n_ele = mesh.n_geometry(DIM);
fem_space.element().resize(n_ele);
for (int i = 0;i < n_ele;i ++) {
fem_space.element(i).reinit(fem_space, i, 0);
}
fem_space.buildElement();
fem_space.buildDof();
fem_space.buildDofBoundaryMark();
std::cout << "Building global indices ... " << std::flush;
global_index_t global_index(forest, fem_space);
global_index.build();
std::cout << "OK!" << std::endl;
std::cout << "Building the linear system ... " << std::flush;
Mat A;
Vec x, b;
MatCreateMPIAIJ(PETSC_COMM_WORLD,
global_index.n_primary_dof(), global_index.n_primary_dof(),
PETSC_DECIDE, PETSC_DECIDE,
0, PETSC_NULL, 0, PETSC_NULL, &A);
VecCreateMPI(PETSC_COMM_WORLD, global_index.n_primary_dof(), PETSC_DECIDE, &b);
fe_space_t::ElementIterator
the_ele = fem_space.beginElement(),
end_ele = fem_space.endElement();
for (;the_ele != end_ele;++ the_ele) {
double vol = the_ele->templateElement().volume();
const QuadratureInfo<DIM>& qi = the_ele->findQuadratureInfo(5);
std::vector<Point<DIM> > q_pnt = the_ele->local_to_global(qi.quadraturePoint());
int n_q_pnt = qi.n_quadraturePoint();
std::vector<double> jac = the_ele->local_to_global_jacobian(qi.quadraturePoint());
std::vector<std::vector<double> > bas_val = the_ele->basis_function_value(q_pnt);
std::vector<std::vector<std::vector<double> > > bas_grad = the_ele->basis_function_gradient(q_pnt);
const std::vector<int>& ele_dof = the_ele->dof();
u_int n_ele_dof = ele_dof.size();
FullMatrix<double> ele_mat(n_ele_dof, n_ele_dof);
Vector<double> ele_rhs(n_ele_dof);
for (u_int l = 0;l < n_q_pnt;++ l) {
double JxW = vol*jac[l]*qi.weight(l);
double f_val = _f_(q_pnt[l]);
for (u_int i = 0;i < n_ele_dof;++ i) {
for (u_int j = 0;j < n_ele_dof;++ j) {
ele_mat(i, j) += JxW*(bas_val[i][l]*bas_val[j][l] +
innerProduct(bas_grad[i][l], bas_grad[j][l]));
}
ele_rhs(i) += JxW*f_val*bas_val[i][l];
}
}
/**
* 此处将单元矩阵和单元载荷先计算好，然后向全局的矩阵和载荷向量上
* 集中，可以提高效率。
*/
std::vector<int> indices(n_ele_dof);
for (u_int i = 0;i < n_ele_dof;++ i) {
indices[i] = global_index(ele_dof[i]);
}
MatSetValues(A, n_ele_dof, &indices[0], n_ele_dof, &indices[0], &ele_mat(0,0), ADD_VALUES);
VecSetValues(b, n_ele_dof, &indices[0], &ele_rhs(0), ADD_VALUES);
}
MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY);
VecAssemblyBegin(b);
MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY);
VecAssemblyEnd(b);
VecDuplicate(b, &x);
std::cout << "OK!" << std::endl;
KSP solver;
KSPCreate(PETSC_COMM_WORLD, &solver);
KSPSetOperators(solver, A, A, SAME_NONZERO_PATTERN);
KSPSetType(solver, KSPCG);
KSPSetFromOptions(solver);
KSPSolve(solver, b, x);
if (forest.rank() == 0) {
KSPConvergedReason reason;
KSPGetConvergedReason(solver,&reason);
if (reason == KSP_DIVERGED_INDEFINITE_PC) {
printf("\nDivergence because of indefinite preconditioner;\n");
printf("Run the executable again but with -pc_ilu_shift option.\n");
} else if (reason<0) {
printf("\nOther kind of divergence: this should not happen.\n");
} else {
PetscInt its;
KSPGetIterationNumber(solver,&its);
printf("\nConvergence in %d iterations.\n",(int)its);
}
printf("\n");
}
MatDestroy(A);
VecDestroy(b);
KSPDestroy(solver);
/// 准备解函数
FEMFunction<double,DIM> u_h(fem_space);
Vec X;
VecCreateSeqWithArray(PETSC_COMM_SELF, global_index.n_local_dof(), &u_h(0), &X);
/// 将 PETSc 解出来的向量取出到有限元函数 u_h 中来
std::vector<int> primary_idx(global_index.n_primary_dof());
global_index.build_primary_index(&primary_idx[0]);
IS is;
ISCreateGeneralWithArray(forest.communicator(), global_index.n_local_dof(),
&global_index(0), &is);
VecScatter scatter;
VecScatterCreate(x, is, X, PETSC_NULL, &scatter);
VecScatterBegin(scatter, x, X, INSERT_VALUES, SCATTER_FORWARD);
VecScatterEnd(scatter, x, X, INSERT_VALUES, SCATTER_FORWARD);
/// 清理 PETSc 的变量
VecDestroy(x);
VecDestroy(X);
VecScatterDestroy(scatter);
ISDestroy(is);
char filename[1024];
sprintf(filename, "u_h%d.dx", forest.rank());
u_h.writeOpenDXData(filename);
PetscFinalize();
return 0;
}
PetscErrorCode MatGetSubMatrices_MPIDense_Local(Mat C,PetscInt ismax,const IS isrow[],const IS iscol[],MatReuse scall,Mat *submats)
{
Mat_MPIDense *c = (Mat_MPIDense*)C->data;
Mat A = c->A;
Mat_SeqDense *a = (Mat_SeqDense*)A->data,*mat;
PetscErrorCode ierr;
PetscMPIInt rank,size,tag0,tag1,idex,end,i;
PetscInt N = C->cmap->N,rstart = C->rmap->rstart,count;
const PetscInt **irow,**icol,*irow_i;
PetscInt *nrow,*ncol,*w1,*w3,*w4,*rtable,start;
PetscInt **sbuf1,m,j,k,l,ct1,**rbuf1,row,proc;
PetscInt nrqs,msz,**ptr,*ctr,*pa,*tmp,bsz,nrqr;
PetscInt is_no,jmax,**rmap,*rmap_i;
PetscInt ctr_j,*sbuf1_j,*rbuf1_i;
MPI_Request *s_waits1,*r_waits1,*s_waits2,*r_waits2;
MPI_Status *r_status1,*r_status2,*s_status1,*s_status2;
MPI_Comm comm;
PetscScalar **rbuf2,**sbuf2;
PetscBool sorted;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)C,&comm);CHKERRQ(ierr);
tag0 = ((PetscObject)C)->tag;
size = c->size;
rank = c->rank;
m = C->rmap->N;
/* Get some new tags to keep the communication clean */
ierr = PetscObjectGetNewTag((PetscObject)C,&tag1);CHKERRQ(ierr);
/* Check if the col indices are sorted */
for (i=0; i<ismax; i++) {
ierr = ISSorted(isrow[i],&sorted);CHKERRQ(ierr);
if (!sorted) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"ISrow is not sorted");
ierr = ISSorted(iscol[i],&sorted);CHKERRQ(ierr);
if (!sorted) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"IScol is not sorted");
}
ierr = PetscMalloc5(ismax,const PetscInt*,&irow,ismax,const PetscInt*,&icol,ismax,PetscInt,&nrow,ismax,PetscInt,&ncol,m,PetscInt,&rtable);CHKERRQ(ierr);
for (i=0; i<ismax; i++) {
ierr = ISGetIndices(isrow[i],&irow[i]);CHKERRQ(ierr);
ierr = ISGetIndices(iscol[i],&icol[i]);CHKERRQ(ierr);
ierr = ISGetLocalSize(isrow[i],&nrow[i]);CHKERRQ(ierr);
ierr = ISGetLocalSize(iscol[i],&ncol[i]);CHKERRQ(ierr);
}
/* Create hash table for the mapping :row -> proc*/
for (i=0,j=0; i<size; i++) {
jmax = C->rmap->range[i+1];
for (; j<jmax; j++) rtable[j] = i;
}
/* evaluate communication - mesg to who,length of mesg, and buffer space
required. Based on this, buffers are allocated, and data copied into them*/
ierr = PetscMalloc3(2*size,PetscInt,&w1,size,PetscInt,&w3,size,PetscInt,&w4);CHKERRQ(ierr);
ierr = PetscMemzero(w1,size*2*sizeof(PetscInt));CHKERRQ(ierr); /* initialize work vector*/
ierr = PetscMemzero(w3,size*sizeof(PetscInt));CHKERRQ(ierr); /* initialize work vector*/
for (i=0; i<ismax; i++) {
ierr = PetscMemzero(w4,size*sizeof(PetscInt));CHKERRQ(ierr); /* initialize work vector*/
jmax = nrow[i];
irow_i = irow[i];
for (j=0; j<jmax; j++) {
row = irow_i[j];
proc = rtable[row];
w4[proc]++;
}
for (j=0; j<size; j++) {
if (w4[j]) { w1[2*j] += w4[j]; w3[j]++;}
}
}
nrqs = 0; /* no of outgoing messages */
msz = 0; /* total mesg length (for all procs) */
w1[2*rank] = 0; /* no mesg sent to self */
w3[rank] = 0;
for (i=0; i<size; i++) {
if (w1[2*i]) { w1[2*i+1] = 1; nrqs++;} /* there exists a message to proc i */
}
ierr = PetscMalloc((nrqs+1)*sizeof(PetscInt),&pa);CHKERRQ(ierr); /*(proc -array)*/
for (i=0,j=0; i<size; i++) {
if (w1[2*i]) { pa[j] = i; j++; }
}
/* Each message would have a header = 1 + 2*(no of IS) + data */
for (i=0; i<nrqs; i++) {
j = pa[i];
w1[2*j] += w1[2*j+1] + 2* w3[j];
msz += w1[2*j];
}
/* Do a global reduction to determine how many messages to expect*/
ierr = PetscMaxSum(comm,w1,&bsz,&nrqr);CHKERRQ(ierr);
/* Allocate memory for recv buffers . Make sure rbuf1[0] exists by adding 1 to the buffer length */
ierr = PetscMalloc((nrqr+1)*sizeof(PetscInt*),&rbuf1);CHKERRQ(ierr);
ierr = PetscMalloc(nrqr*bsz*sizeof(PetscInt),&rbuf1[0]);CHKERRQ(ierr);
for (i=1; i<nrqr; ++i) rbuf1[i] = rbuf1[i-1] + bsz;
/* Post the receives */
ierr = PetscMalloc((nrqr+1)*sizeof(MPI_Request),&r_waits1);CHKERRQ(ierr);
for (i=0; i<nrqr; ++i) {
ierr = MPI_Irecv(rbuf1[i],bsz,MPIU_INT,MPI_ANY_SOURCE,tag0,comm,r_waits1+i);CHKERRQ(ierr);
}
/* Allocate Memory for outgoing messages */
ierr = PetscMalloc4(size,PetscInt*,&sbuf1,size,PetscInt*,&ptr,2*msz,PetscInt,&tmp,size,PetscInt,&ctr);CHKERRQ(ierr);
ierr = PetscMemzero(sbuf1,size*sizeof(PetscInt*));CHKERRQ(ierr);
ierr = PetscMemzero(ptr,size*sizeof(PetscInt*));CHKERRQ(ierr);
{
PetscInt *iptr = tmp,ict = 0;
for (i=0; i<nrqs; i++) {
j = pa[i];
iptr += ict;
sbuf1[j] = iptr;
ict = w1[2*j];
}
}
/* Form the outgoing messages */
/* Initialize the header space */
for (i=0; i<nrqs; i++) {
j = pa[i];
sbuf1[j][0] = 0;
ierr = PetscMemzero(sbuf1[j]+1,2*w3[j]*sizeof(PetscInt));CHKERRQ(ierr);
ptr[j] = sbuf1[j] + 2*w3[j] + 1;
}
/* Parse the isrow and copy data into outbuf */
for (i=0; i<ismax; i++) {
ierr = PetscMemzero(ctr,size*sizeof(PetscInt));CHKERRQ(ierr);
irow_i = irow[i];
jmax = nrow[i];
for (j=0; j<jmax; j++) { /* parse the indices of each IS */
row = irow_i[j];
proc = rtable[row];
if (proc != rank) { /* copy to the outgoing buf*/
ctr[proc]++;
*ptr[proc] = row;
ptr[proc]++;
}
}
/* Update the headers for the current IS */
for (j=0; j<size; j++) { /* Can Optimise this loop too */
if ((ctr_j = ctr[j])) {
sbuf1_j = sbuf1[j];
k = ++sbuf1_j[0];
sbuf1_j[2*k] = ctr_j;
sbuf1_j[2*k-1] = i;
}
}
}
/* Now post the sends */
ierr = PetscMalloc((nrqs+1)*sizeof(MPI_Request),&s_waits1);CHKERRQ(ierr);
for (i=0; i<nrqs; ++i) {
j = pa[i];
ierr = MPI_Isend(sbuf1[j],w1[2*j],MPIU_INT,j,tag0,comm,s_waits1+i);CHKERRQ(ierr);
}
/* Post recieves to capture the row_data from other procs */
ierr = PetscMalloc((nrqs+1)*sizeof(MPI_Request),&r_waits2);CHKERRQ(ierr);
ierr = PetscMalloc((nrqs+1)*sizeof(PetscScalar*),&rbuf2);CHKERRQ(ierr);
for (i=0; i<nrqs; i++) {
j = pa[i];
count = (w1[2*j] - (2*sbuf1[j][0] + 1))*N;
ierr = PetscMalloc((count+1)*sizeof(PetscScalar),&rbuf2[i]);CHKERRQ(ierr);
ierr = MPI_Irecv(rbuf2[i],count,MPIU_SCALAR,j,tag1,comm,r_waits2+i);CHKERRQ(ierr);
}
/* Receive messages(row_nos) and then, pack and send off the rowvalues
to the correct processors */
ierr = PetscMalloc((nrqr+1)*sizeof(MPI_Request),&s_waits2);CHKERRQ(ierr);
ierr = PetscMalloc((nrqr+1)*sizeof(MPI_Status),&r_status1);CHKERRQ(ierr);
ierr = PetscMalloc((nrqr+1)*sizeof(PetscScalar*),&sbuf2);CHKERRQ(ierr);
{
PetscScalar *sbuf2_i,*v_start;
PetscInt s_proc;
for (i=0; i<nrqr; ++i) {
ierr = MPI_Waitany(nrqr,r_waits1,&idex,r_status1+i);CHKERRQ(ierr);
s_proc = r_status1[i].MPI_SOURCE; /* send processor */
rbuf1_i = rbuf1[idex]; /* Actual message from s_proc */
/* no of rows = end - start; since start is array idex[], 0idex, whel end
is length of the buffer - which is 1idex */
start = 2*rbuf1_i[0] + 1;
ierr = MPI_Get_count(r_status1+i,MPIU_INT,&end);CHKERRQ(ierr);
/* allocate memory sufficinet to hold all the row values */
ierr = PetscMalloc((end-start)*N*sizeof(PetscScalar),&sbuf2[idex]);CHKERRQ(ierr);
sbuf2_i = sbuf2[idex];
/* Now pack the data */
for (j=start; j<end; j++) {
row = rbuf1_i[j] - rstart;
v_start = a->v + row;
for (k=0; k<N; k++) {
sbuf2_i[0] = v_start[0];
sbuf2_i++;
v_start += C->rmap->n;
}
}
/* Now send off the data */
ierr = MPI_Isend(sbuf2[idex],(end-start)*N,MPIU_SCALAR,s_proc,tag1,comm,s_waits2+i);CHKERRQ(ierr);
}
}
/* End Send-Recv of IS + row_numbers */
ierr = PetscFree(r_status1);CHKERRQ(ierr);
ierr = PetscFree(r_waits1);CHKERRQ(ierr);
ierr = PetscMalloc((nrqs+1)*sizeof(MPI_Status),&s_status1);CHKERRQ(ierr);
if (nrqs) {ierr = MPI_Waitall(nrqs,s_waits1,s_status1);CHKERRQ(ierr);}
ierr = PetscFree(s_status1);CHKERRQ(ierr);
ierr = PetscFree(s_waits1);CHKERRQ(ierr);
/* Create the submatrices */
if (scall == MAT_REUSE_MATRIX) {
for (i=0; i<ismax; i++) {
mat = (Mat_SeqDense*)(submats[i]->data);
if ((submats[i]->rmap->n != nrow[i]) || (submats[i]->cmap->n != ncol[i])) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Cannot reuse matrix. wrong size");
ierr = PetscMemzero(mat->v,submats[i]->rmap->n*submats[i]->cmap->n*sizeof(PetscScalar));CHKERRQ(ierr);
submats[i]->factortype = C->factortype;
}
} else {
for (i=0; i<ismax; i++) {
ierr = MatCreate(PETSC_COMM_SELF,submats+i);CHKERRQ(ierr);
ierr = MatSetSizes(submats[i],nrow[i],ncol[i],nrow[i],ncol[i]);CHKERRQ(ierr);
ierr = MatSetType(submats[i],((PetscObject)A)->type_name);CHKERRQ(ierr);
ierr = MatSeqDenseSetPreallocation(submats[i],NULL);CHKERRQ(ierr);
}
}
/* Assemble the matrices */
{
PetscInt col;
PetscScalar *imat_v,*mat_v,*imat_vi,*mat_vi;
for (i=0; i<ismax; i++) {
mat = (Mat_SeqDense*)submats[i]->data;
mat_v = a->v;
imat_v = mat->v;
irow_i = irow[i];
m = nrow[i];
for (j=0; j<m; j++) {
row = irow_i[j];
proc = rtable[row];
if (proc == rank) {
row = row - rstart;
mat_vi = mat_v + row;
imat_vi = imat_v + j;
for (k=0; k<ncol[i]; k++) {
col = icol[i][k];
imat_vi[k*m] = mat_vi[col*C->rmap->n];
}
}
}
}
}
/* Create row map-> This maps c->row to submat->row for each submat*/
/* this is a very expensive operation wrt memory usage */
ierr = PetscMalloc(ismax*sizeof(PetscInt*),&rmap);CHKERRQ(ierr);
ierr = PetscMalloc(ismax*C->rmap->N*sizeof(PetscInt),&rmap[0]);CHKERRQ(ierr);
ierr = PetscMemzero(rmap[0],ismax*C->rmap->N*sizeof(PetscInt));CHKERRQ(ierr);
for (i=1; i<ismax; i++) rmap[i] = rmap[i-1] + C->rmap->N;
for (i=0; i<ismax; i++) {
rmap_i = rmap[i];
irow_i = irow[i];
jmax = nrow[i];
for (j=0; j<jmax; j++) {
rmap_i[irow_i[j]] = j;
}
}
/* Now Receive the row_values and assemble the rest of the matrix */
ierr = PetscMalloc((nrqs+1)*sizeof(MPI_Status),&r_status2);CHKERRQ(ierr);
{
PetscInt is_max,tmp1,col,*sbuf1_i,is_sz;
PetscScalar *rbuf2_i,*imat_v,*imat_vi;
for (tmp1=0; tmp1<nrqs; tmp1++) { /* For each message */
ierr = MPI_Waitany(nrqs,r_waits2,&i,r_status2+tmp1);CHKERRQ(ierr);
/* Now dig out the corresponding sbuf1, which contains the IS data_structure */
sbuf1_i = sbuf1[pa[i]];
is_max = sbuf1_i[0];
ct1 = 2*is_max+1;
rbuf2_i = rbuf2[i];
for (j=1; j<=is_max; j++) { /* For each IS belonging to the message */
is_no = sbuf1_i[2*j-1];
is_sz = sbuf1_i[2*j];
mat = (Mat_SeqDense*)submats[is_no]->data;
imat_v = mat->v;
rmap_i = rmap[is_no];
m = nrow[is_no];
for (k=0; k<is_sz; k++,rbuf2_i+=N) { /* For each row */
row = sbuf1_i[ct1]; ct1++;
row = rmap_i[row];
imat_vi = imat_v + row;
for (l=0; l<ncol[is_no]; l++) { /* For each col */
col = icol[is_no][l];
imat_vi[l*m] = rbuf2_i[col];
}
}
}
}
}
/* End Send-Recv of row_values */
ierr = PetscFree(r_status2);CHKERRQ(ierr);
ierr = PetscFree(r_waits2);CHKERRQ(ierr);
ierr = PetscMalloc((nrqr+1)*sizeof(MPI_Status),&s_status2);CHKERRQ(ierr);
if (nrqr) {ierr = MPI_Waitall(nrqr,s_waits2,s_status2);CHKERRQ(ierr);}
ierr = PetscFree(s_status2);CHKERRQ(ierr);
ierr = PetscFree(s_waits2);CHKERRQ(ierr);
/* Restore the indices */
for (i=0; i<ismax; i++) {
ierr = ISRestoreIndices(isrow[i],irow+i);CHKERRQ(ierr);
ierr = ISRestoreIndices(iscol[i],icol+i);CHKERRQ(ierr);
}
/* Destroy allocated memory */
ierr = PetscFree5(irow,icol,nrow,ncol,rtable);CHKERRQ(ierr);
ierr = PetscFree3(w1,w3,w4);CHKERRQ(ierr);
ierr = PetscFree(pa);CHKERRQ(ierr);
for (i=0; i<nrqs; ++i) {
ierr = PetscFree(rbuf2[i]);CHKERRQ(ierr);
}
ierr = PetscFree(rbuf2);CHKERRQ(ierr);
ierr = PetscFree4(sbuf1,ptr,tmp,ctr);CHKERRQ(ierr);
ierr = PetscFree(rbuf1[0]);CHKERRQ(ierr);
ierr = PetscFree(rbuf1);CHKERRQ(ierr);
for (i=0; i<nrqr; ++i) {
ierr = PetscFree(sbuf2[i]);CHKERRQ(ierr);
}
ierr = PetscFree(sbuf2);CHKERRQ(ierr);
ierr = PetscFree(rmap[0]);CHKERRQ(ierr);
ierr = PetscFree(rmap);CHKERRQ(ierr);
for (i=0; i<ismax; i++) {
ierr = MatAssemblyBegin(submats[i],MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(submats[i],MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode ComputeSubdomainMatrix(DomainData dd, GLLData glldata, Mat *local_mat)
{
PetscErrorCode ierr;
PetscInt localsize,zloc,yloc,xloc,auxnex,auxney,auxnez;
PetscInt ie,je,ke,i,j,k,ig,jg,kg,ii,ming;
PetscInt *indexg,*cols,*colsg;
PetscScalar *vals;
Mat temp_local_mat,elem_mat_DBC=0,*usedmat;
IS submatIS;
PetscFunctionBeginUser;
ierr = MatGetSize(glldata.elem_mat,&i,&j);CHKERRQ(ierr);
ierr = PetscMalloc1(i,&indexg);CHKERRQ(ierr);
ierr = PetscMalloc1(i,&colsg);CHKERRQ(ierr);
/* get submatrix of elem_mat without dirichlet nodes */
if (!dd.pure_neumann && !dd.DBC_zerorows && !dd.ipx) {
xloc = dd.p+1;
yloc = 1;
zloc = 1;
if (dd.dim>1) yloc = dd.p+1;
if (dd.dim>2) zloc = dd.p+1;
ii = 0;
for (k=0;k<zloc;k++) {
for (j=0;j<yloc;j++) {
for (i=1;i<xloc;i++) {
indexg[ii]=k*xloc*yloc+j*xloc+i;
ii++;
}
}
}
ierr = ISCreateGeneral(PETSC_COMM_SELF,ii,indexg,PETSC_COPY_VALUES,&submatIS);CHKERRQ(ierr);
ierr = MatGetSubMatrix(glldata.elem_mat,submatIS,submatIS,MAT_INITIAL_MATRIX,&elem_mat_DBC);CHKERRQ(ierr);
ierr = ISDestroy(&submatIS);CHKERRQ(ierr);
}
/* Assemble subdomain matrix */
localsize = dd.xm_l*dd.ym_l*dd.zm_l;
ierr = MatCreate(PETSC_COMM_SELF,&temp_local_mat);CHKERRQ(ierr);
ierr = MatSetSizes(temp_local_mat,localsize,localsize,localsize,localsize);CHKERRQ(ierr);
ierr = MatSetOptionsPrefix(temp_local_mat,"subdomain_");CHKERRQ(ierr);
/* set local matrices type: here we use SEQSBAIJ primarily for testing purpose */
/* in order to avoid conversions inside the BDDC code, use SeqAIJ if possible */
if (dd.DBC_zerorows && !dd.ipx) { /* in this case, we need to zero out some of the rows, so use seqaij */
ierr = MatSetType(temp_local_mat,MATSEQAIJ);CHKERRQ(ierr);
} else {
ierr = MatSetType(temp_local_mat,MATSEQSBAIJ);CHKERRQ(ierr);
}
ierr = MatSetFromOptions(temp_local_mat);CHKERRQ(ierr);
i = PetscPowRealInt(3.0*(dd.p+1.0),dd.dim);
ierr = MatSeqAIJSetPreallocation(temp_local_mat,i,NULL);CHKERRQ(ierr); /* very overestimated */
ierr = MatSeqSBAIJSetPreallocation(temp_local_mat,1,i,NULL);CHKERRQ(ierr); /* very overestimated */
ierr = MatSetOption(temp_local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
yloc = dd.p+1;
zloc = dd.p+1;
if (dd.dim < 3) zloc = 1;
if (dd.dim < 2) yloc = 1;
auxnez = dd.nez_l;
auxney = dd.ney_l;
auxnex = dd.nex_l;
if (dd.dim < 3) auxnez = 1;
if (dd.dim < 2) auxney = 1;
for (ke=0; ke<auxnez; ke++) {
for (je=0; je<auxney; je++) {
for (ie=0; ie<auxnex; ie++) {
/* customize element accounting for BC */
xloc = dd.p+1;
ming = 0;
usedmat = &glldata.elem_mat;
if (!dd.pure_neumann && !dd.DBC_zerorows && !dd.ipx) {
if (ie == 0) {
xloc = dd.p;
usedmat = &elem_mat_DBC;
} else {
ming = -1;
usedmat = &glldata.elem_mat;
}
}
/* local to the element/global to the subdomain indexing */
for (k=0; k<zloc; k++) {
kg = ke*dd.p+k;
for (j=0; j<yloc; j++) {
jg = je*dd.p+j;
for (i=0; i<xloc; i++) {
ig = ie*dd.p+i+ming;
ii = k*xloc*yloc+j*xloc+i;
indexg[ii] = kg*dd.xm_l*dd.ym_l+jg*dd.xm_l+ig;
}
}
}
/* Set values */
for (i=0; i<xloc*yloc*zloc; i++) {
ierr = MatGetRow(*usedmat,i,&j,(const PetscInt**)&cols,(const PetscScalar**)&vals);CHKERRQ(ierr);
for (k=0; k<j; k++) colsg[k] = indexg[cols[k]];
ierr = MatSetValues(temp_local_mat,1,&indexg[i],j,colsg,vals,ADD_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(*usedmat,i,&j,(const PetscInt**)&cols,(const PetscScalar**)&vals);CHKERRQ(ierr);
}
}
}
}
ierr = PetscFree(indexg);CHKERRQ(ierr);
ierr = PetscFree(colsg);CHKERRQ(ierr);
ierr = MatAssemblyBegin(temp_local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (temp_local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
#if DEBUG
{
Vec lvec,rvec;
PetscReal norm;
ierr = MatCreateVecs(temp_local_mat,&lvec,&rvec);CHKERRQ(ierr);
ierr = VecSet(lvec,1.0);CHKERRQ(ierr);
ierr = MatMult(temp_local_mat,lvec,rvec);CHKERRQ(ierr);
ierr = VecNorm(rvec,NORM_INFINITY,&norm);CHKERRQ(ierr);
printf("Test null space of local mat % 1.14e\n",norm);
ierr = VecDestroy(&lvec);CHKERRQ(ierr);
ierr = VecDestroy(&rvec);CHKERRQ(ierr);
}
#endif
*local_mat = temp_local_mat;
ierr = MatDestroy(&elem_mat_DBC);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode FormJacobian_All(SNES snes,Vec X,Mat J,Mat B,void *ctx)
{
User user = (User)ctx;
DM dau,dak;
DMDALocalInfo infou,infok;
PetscScalar *u,*k;
PetscErrorCode ierr;
Vec Uloc,Kloc;
PetscFunctionBeginUser;
ierr = DMCompositeGetEntries(user->pack,&dau,&dak);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(dau,&infou);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(dak,&infok);CHKERRQ(ierr);
ierr = DMCompositeGetLocalVectors(user->pack,&Uloc,&Kloc);CHKERRQ(ierr);
switch (user->ptype) {
case 0:
ierr = DMGlobalToLocalBegin(dau,X,INSERT_VALUES,Uloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd (dau,X,INSERT_VALUES,Uloc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dau,Uloc,&u);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dak,user->Kloc,&k);CHKERRQ(ierr);
ierr = FormJacobianLocal_U(user,&infou,u,k,B);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(dau,Uloc,&u);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(dak,user->Kloc,&k);CHKERRQ(ierr);
break;
case 1:
ierr = DMGlobalToLocalBegin(dak,X,INSERT_VALUES,Kloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd (dak,X,INSERT_VALUES,Kloc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dau,user->Uloc,&u);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dak,Kloc,&k);CHKERRQ(ierr);
ierr = FormJacobianLocal_K(user,&infok,u,k,B);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(dau,user->Uloc,&u);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(dak,Kloc,&k);CHKERRQ(ierr);
break;
case 2: {
Mat Buu,Buk,Bku,Bkk;
IS *is;
ierr = DMCompositeScatter(user->pack,X,Uloc,Kloc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dau,Uloc,&u);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dak,Kloc,&k);CHKERRQ(ierr);
ierr = DMCompositeGetLocalISs(user->pack,&is);CHKERRQ(ierr);
ierr = MatGetLocalSubMatrix(B,is[0],is[0],&Buu);CHKERRQ(ierr);
ierr = MatGetLocalSubMatrix(B,is[0],is[1],&Buk);CHKERRQ(ierr);
ierr = MatGetLocalSubMatrix(B,is[1],is[0],&Bku);CHKERRQ(ierr);
ierr = MatGetLocalSubMatrix(B,is[1],is[1],&Bkk);CHKERRQ(ierr);
ierr = FormJacobianLocal_U(user,&infou,u,k,Buu);CHKERRQ(ierr);
ierr = FormJacobianLocal_UK(user,&infou,&infok,u,k,Buk);CHKERRQ(ierr);
ierr = FormJacobianLocal_KU(user,&infou,&infok,u,k,Bku);CHKERRQ(ierr);
ierr = FormJacobianLocal_K(user,&infok,u,k,Bkk);CHKERRQ(ierr);
ierr = MatRestoreLocalSubMatrix(B,is[0],is[0],&Buu);CHKERRQ(ierr);
ierr = MatRestoreLocalSubMatrix(B,is[0],is[1],&Buk);CHKERRQ(ierr);
ierr = MatRestoreLocalSubMatrix(B,is[1],is[0],&Bku);CHKERRQ(ierr);
ierr = MatRestoreLocalSubMatrix(B,is[1],is[1],&Bkk);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(dau,Uloc,&u);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(dak,Kloc,&k);CHKERRQ(ierr);
ierr = ISDestroy(&is[0]);CHKERRQ(ierr);
ierr = ISDestroy(&is[1]);CHKERRQ(ierr);
ierr = PetscFree(is);CHKERRQ(ierr);
} break;
}
ierr = DMCompositeRestoreLocalVectors(user->pack,&Uloc,&Kloc);CHKERRQ(ierr);
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (J != B) {
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode GLLStuffs(DomainData dd, GLLData *glldata)
{
PetscErrorCode ierr;
PetscReal *M,si;
PetscScalar x,z0,z1,z2,Lpj,Lpr,rhoGLj,rhoGLk;
PetscBLASInt pm1,lierr;
PetscInt i,j,n,k,s,r,q,ii,jj,p=dd.p;
PetscInt xloc,yloc,zloc,xyloc,xyzloc;
PetscFunctionBeginUser;
/* Gauss-Lobatto-Legendre nodes zGL on [-1,1] */
ierr = PetscMalloc1(p+1,&glldata->zGL);CHKERRQ(ierr);
ierr = PetscMemzero(glldata->zGL,(p+1)*sizeof(*glldata->zGL));CHKERRQ(ierr);
glldata->zGL[0]=-1.0;
glldata->zGL[p]= 1.0;
if (p > 1) {
if (p == 2) glldata->zGL[1]=0.0;
else {
ierr = PetscMalloc1(p-1,&M);CHKERRQ(ierr);
for (i=0; i<p-1; i++) {
si = (PetscReal)(i+1.0);
M[i]=0.5*PetscSqrtReal(si*(si+2.0)/((si+0.5)*(si+1.5)));
}
pm1 = p-1;
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
PetscStackCallBLAS("LAPACKsteqr",LAPACKsteqr_("N",&pm1,&glldata->zGL[1],M,&x,&pm1,M,&lierr));
if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in STERF Lapack routine %d",(int)lierr);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
ierr = PetscFree(M);CHKERRQ(ierr);
}
}
/* Weights for 1D quadrature */
ierr = PetscMalloc1(p+1,&glldata->rhoGL);CHKERRQ(ierr);
glldata->rhoGL[0]=2.0/(PetscScalar)(p*(p+1.0));
glldata->rhoGL[p]=glldata->rhoGL[0];
z2 = -1; /* Dummy value to avoid -Wmaybe-initialized */
for (i=1; i<p; i++) {
x = glldata->zGL[i];
z0 = 1.0;
z1 = x;
for (n=1; n<p; n++) {
z2 = x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0));
z0 = z1;
z1 = z2;
}
glldata->rhoGL[i]=2.0/(p*(p+1.0)*z2*z2);
}
/* Auxiliary mat for laplacian */
ierr = PetscMalloc1(p+1,&glldata->A);CHKERRQ(ierr);
ierr = PetscMalloc1((p+1)*(p+1),&glldata->A[0]);CHKERRQ(ierr);
for (i=1; i<p+1; i++) glldata->A[i]=glldata->A[i-1]+p+1;
for (j=1; j<p; j++) {
x =glldata->zGL[j];
z0=1.0;
z1=x;
for (n=1; n<p; n++) {
z2=x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0));
z0=z1;
z1=z2;
}
Lpj=z2;
for (r=1; r<p; r++) {
if (r == j) {
glldata->A[j][j]=2.0/(3.0*(1.0-glldata->zGL[j]*glldata->zGL[j])*Lpj*Lpj);
} else {
x = glldata->zGL[r];
z0 = 1.0;
z1 = x;
for (n=1; n<p; n++) {
z2=x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0));
z0=z1;
z1=z2;
}
Lpr = z2;
glldata->A[r][j]=4.0/(p*(p+1.0)*Lpj*Lpr*(glldata->zGL[j]-glldata->zGL[r])*(glldata->zGL[j]-glldata->zGL[r]));
}
}
}
for (j=1; j<p+1; j++) {
x = glldata->zGL[j];
z0 = 1.0;
z1 = x;
for (n=1; n<p; n++) {
z2=x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0));
z0=z1;
z1=z2;
}
Lpj = z2;
glldata->A[j][0]=4.0*PetscPowRealInt(-1.0,p)/(p*(p+1.0)*Lpj*(1.0+glldata->zGL[j])*(1.0+glldata->zGL[j]));
glldata->A[0][j]=glldata->A[j][0];
}
for (j=0; j<p; j++) {
x = glldata->zGL[j];
z0 = 1.0;
z1 = x;
for (n=1; n<p; n++) {
z2=x*z1*(2.0*n+1.0)/(n+1.0)-z0*(PetscScalar)(n/(n+1.0));
z0=z1;
z1=z2;
}
Lpj=z2;
glldata->A[p][j]=4.0/(p*(p+1.0)*Lpj*(1.0-glldata->zGL[j])*(1.0-glldata->zGL[j]));
glldata->A[j][p]=glldata->A[p][j];
}
glldata->A[0][0]=0.5+(p*(p+1.0)-2.0)/6.0;
glldata->A[p][p]=glldata->A[0][0];
/* compute element matrix */
xloc = p+1;
yloc = p+1;
zloc = p+1;
if (dd.dim<2) yloc=1;
if (dd.dim<3) zloc=1;
xyloc = xloc*yloc;
xyzloc = xloc*yloc*zloc;
ierr = MatCreate(PETSC_COMM_SELF,&glldata->elem_mat);CHKERRQ(ierr);
ierr = MatSetSizes(glldata->elem_mat,xyzloc,xyzloc,xyzloc,xyzloc);CHKERRQ(ierr);
ierr = MatSetType(glldata->elem_mat,MATSEQAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(glldata->elem_mat,xyzloc,NULL);CHKERRQ(ierr); /* overestimated */
ierr = MatZeroEntries(glldata->elem_mat);CHKERRQ(ierr);
ierr = MatSetOption(glldata->elem_mat,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
for (k=0; k<zloc; k++) {
if (dd.dim>2) rhoGLk=glldata->rhoGL[k];
else rhoGLk=1.0;
for (j=0; j<yloc; j++) {
if (dd.dim>1) rhoGLj=glldata->rhoGL[j];
else rhoGLj=1.0;
for (i=0; i<xloc; i++) {
ii = k*xyloc+j*xloc+i;
s = k;
r = j;
for (q=0; q<xloc; q++) {
jj = s*xyloc+r*xloc+q;
ierr = MatSetValue(glldata->elem_mat,jj,ii,glldata->A[i][q]*rhoGLj*rhoGLk,ADD_VALUES);CHKERRQ(ierr);
}
if (dd.dim>1) {
s=k;
q=i;
for (r=0; r<yloc; r++) {
jj = s*xyloc+r*xloc+q;
ierr = MatSetValue(glldata->elem_mat,jj,ii,glldata->A[j][r]*glldata->rhoGL[i]*rhoGLk,ADD_VALUES);CHKERRQ(ierr);
}
}
if (dd.dim>2) {
r=j;
q=i;
for (s=0; s<zloc; s++) {
jj = s*xyloc+r*xloc+q;
ierr = MatSetValue(glldata->elem_mat,jj,ii,glldata->A[k][s]*rhoGLj*glldata->rhoGL[i],ADD_VALUES);CHKERRQ(ierr);
}
}
}
}
}
ierr = MatAssemblyBegin(glldata->elem_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (glldata->elem_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
#if DEBUG
{
Vec lvec,rvec;
PetscReal norm;
ierr = MatCreateVecs(glldata->elem_mat,&lvec,&rvec);CHKERRQ(ierr);
ierr = VecSet(lvec,1.0);CHKERRQ(ierr);
ierr = MatMult(glldata->elem_mat,lvec,rvec);CHKERRQ(ierr);
ierr = VecNorm(rvec,NORM_INFINITY,&norm);CHKERRQ(ierr);
printf("Test null space of elem mat % 1.14e\n",norm);
ierr = VecDestroy(&lvec);CHKERRQ(ierr);
ierr = VecDestroy(&rvec);CHKERRQ(ierr);
}
#endif
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
KSP solver;
PC prec;
Mat A,M;
Vec X,B,D;
MPI_Comm comm;
PetscScalar v;
KSPConvergedReason reason;
PetscInt i,j,its;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc,&argv,0,help);if (ierr) return ierr;
comm = MPI_COMM_SELF;
/*
* Construct the Kershaw matrix
* and a suitable rhs / initial guess
*/
ierr = MatCreateSeqAIJ(comm,4,4,4,0,&A);CHKERRQ(ierr);
ierr = VecCreateSeq(comm,4,&B);CHKERRQ(ierr);
ierr = VecDuplicate(B,&X);CHKERRQ(ierr);
for (i=0; i<4; i++) {
v = 3;
ierr = MatSetValues(A,1,&i,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
v = 1;
ierr = VecSetValues(B,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecSetValues(X,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
}
i=0; v=0;
ierr = VecSetValues(X,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
for (i=0; i<3; i++) {
v = -2; j=i+1;
ierr = MatSetValues(A,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(A,1,&j,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
}
i=0; j=3; v=2;
ierr = MatSetValues(A,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(A,1,&j,1,&i,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = VecAssemblyBegin(B);CHKERRQ(ierr);
ierr = VecAssemblyEnd(B);CHKERRQ(ierr);
/*
* A Conjugate Gradient method
* with ILU(0) preconditioning
*/
ierr = KSPCreate(comm,&solver);CHKERRQ(ierr);
ierr = KSPSetOperators(solver,A,A);CHKERRQ(ierr);
ierr = KSPSetType(solver,KSPCG);CHKERRQ(ierr);
ierr = KSPSetInitialGuessNonzero(solver,PETSC_TRUE);CHKERRQ(ierr);
/*
* ILU preconditioner;
* this will break down unless you add the Shift line,
* or use the -pc_factor_shift_positive_definite option */
ierr = KSPGetPC(solver,&prec);CHKERRQ(ierr);
ierr = PCSetType(prec,PCILU);CHKERRQ(ierr);
/* ierr = PCFactorSetShiftType(prec,MAT_SHIFT_POSITIVE_DEFINITE);CHKERRQ(ierr); */
ierr = KSPSetFromOptions(solver);CHKERRQ(ierr);
ierr = KSPSetUp(solver);CHKERRQ(ierr);
/*
* Now that the factorisation is done, show the pivots;
* note that the last one is negative. This in itself is not an error,
* but it will make the iterative method diverge.
*/
ierr = PCFactorGetMatrix(prec,&M);CHKERRQ(ierr);
ierr = VecDuplicate(B,&D);CHKERRQ(ierr);
ierr = MatGetDiagonal(M,D);CHKERRQ(ierr);
/*
* Solve the system;
* without the shift this will diverge with
* an indefinite preconditioner
*/
ierr = KSPSolve(solver,B,X);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(solver,&reason);CHKERRQ(ierr);
if (reason==KSP_DIVERGED_INDEFINITE_PC) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nDivergence because of indefinite preconditioner;\n");CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Run the executable again but with '-pc_factor_shift_type POSITIVE_DEFINITE' option.\n");CHKERRQ(ierr);
} else if (reason<0) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nOther kind of divergence: this should not happen.\n");CHKERRQ(ierr);
} else {
ierr = KSPGetIterationNumber(solver,&its);CHKERRQ(ierr);
}
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = VecDestroy(&B);CHKERRQ(ierr);
ierr = VecDestroy(&D);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = KSPDestroy(&solver);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
static PetscErrorCode ComputeMatrix(DomainData dd, Mat *A)
{
PetscErrorCode ierr;
GLLData gll;
Mat local_mat =0,temp_A=0;
ISLocalToGlobalMapping matis_map =0;
IS dirichletIS=0;
PetscFunctionBeginUser;
/* Compute some stuff of Gauss-Legendre-Lobatto quadrature rule */
ierr = GLLStuffs(dd,&gll);CHKERRQ(ierr);
/* Compute matrix of subdomain Neumann problem */
ierr = ComputeSubdomainMatrix(dd,gll,&local_mat);CHKERRQ(ierr);
/* Compute global mapping of local dofs */
ierr = ComputeMapping(dd,&matis_map);CHKERRQ(ierr);
/* Create MATIS object needed by BDDC */
ierr = MatCreateIS(dd.gcomm,1,PETSC_DECIDE,PETSC_DECIDE,dd.xm*dd.ym*dd.zm,dd.xm*dd.ym*dd.zm,matis_map,NULL,&temp_A);CHKERRQ(ierr);
/* Set local subdomain matrices into MATIS object */
ierr = MatScale(local_mat,dd.scalingfactor);CHKERRQ(ierr);
ierr = MatISSetLocalMat(temp_A,local_mat);CHKERRQ(ierr);
/* Call assembly functions */
ierr = MatAssemblyBegin(temp_A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(temp_A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (dd.DBC_zerorows) {
PetscInt dirsize;
ierr = ComputeSpecialBoundaryIndices(dd,&dirichletIS,NULL);CHKERRQ(ierr);
ierr = MatSetOption(local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatZeroRowsLocalIS(temp_A,dirichletIS,1.0,NULL,NULL);CHKERRQ(ierr);
ierr = ISGetLocalSize(dirichletIS,&dirsize);CHKERRQ(ierr);
/* giving hints to local and global matrices could be useful for the BDDC */
if (!dirsize) {
ierr = MatSetOption(local_mat,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatSetOption(local_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
} else {
ierr = MatSetOption(local_mat,MAT_SYMMETRIC,PETSC_FALSE);CHKERRQ(ierr);
ierr = MatSetOption(local_mat,MAT_SPD,PETSC_FALSE);CHKERRQ(ierr);
}
ierr = ISDestroy(&dirichletIS);CHKERRQ(ierr);
} else { /* safe to set the options for the global matrices (they will be communicated to the matis local matrices) */
ierr = MatSetOption(temp_A,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatSetOption(temp_A,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
}
#if DEBUG
{
Vec lvec,rvec;
PetscReal norm;
ierr = MatCreateVecs(temp_A,&lvec,&rvec);CHKERRQ(ierr);
ierr = VecSet(lvec,1.0);CHKERRQ(ierr);
ierr = MatMult(temp_A,lvec,rvec);CHKERRQ(ierr);
ierr = VecNorm(rvec,NORM_INFINITY,&norm);CHKERRQ(ierr);
printf("Test null space of global mat % 1.14e\n",norm);
ierr = VecDestroy(&lvec);CHKERRQ(ierr);
ierr = VecDestroy(&rvec);CHKERRQ(ierr);
}
#endif
/* free allocated workspace */
ierr = PetscFree(gll.zGL);CHKERRQ(ierr);
ierr = PetscFree(gll.rhoGL);CHKERRQ(ierr);
ierr = PetscFree(gll.A[0]);CHKERRQ(ierr);
ierr = PetscFree(gll.A);CHKERRQ(ierr);
ierr = MatDestroy(&gll.elem_mat);CHKERRQ(ierr);
ierr = MatDestroy(&local_mat);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingDestroy(&matis_map);CHKERRQ(ierr);
/* give back the pointer to te MATIS object */
*A = temp_A;
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat C;
PetscInt i,j,m = 3,n = 3,Ii,J;
PetscErrorCode ierr;
PetscBool flg;
PetscScalar v;
IS perm,iperm;
Vec x,u,b,y;
PetscReal norm,tol=PETSC_SMALL;
MatFactorInfo info;
PetscMPIInt size;
PetscInitialize(&argc,&args,(char*)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);
CHKERRQ(ierr);
if (size != 1) SETERRQ(PETSC_COMM_WORLD,1,"This is a uniprocessor example only!");
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 = MatSetUp(C);
CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-symmetric",&flg);
CHKERRQ(ierr);
if (flg) { /* Treat matrix as symmetric only if we set this flag */
ierr = MatSetOption(C,MAT_SYMMETRIC,PETSC_TRUE);
CHKERRQ(ierr);
ierr = MatSetOption(C,MAT_SYMMETRY_ETERNAL,PETSC_TRUE);
CHKERRQ(ierr);
}
/* Create the matrix for the five point stencil, YET AGAIN */
for (i=0; i<m; i++) {
for (j=0; j<n; 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 = MatGetOrdering(C,MATORDERINGRCM,&perm,&iperm);
CHKERRQ(ierr);
ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);
CHKERRQ(ierr);
ierr = ISView(perm,PETSC_VIEWER_STDOUT_SELF);
CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,m*n,&u);
CHKERRQ(ierr);
ierr = VecSet(u,1.0);
CHKERRQ(ierr);
ierr = VecDuplicate(u,&x);
CHKERRQ(ierr);
ierr = VecDuplicate(u,&b);
CHKERRQ(ierr);
ierr = VecDuplicate(u,&y);
CHKERRQ(ierr);
ierr = MatMult(C,u,b);
CHKERRQ(ierr);
ierr = VecCopy(b,y);
CHKERRQ(ierr);
ierr = VecScale(y,2.0);
CHKERRQ(ierr);
ierr = MatNorm(C,NORM_FROBENIUS,&norm);
CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"Frobenius norm of matrix %g\n",(double)norm);
CHKERRQ(ierr);
ierr = MatNorm(C,NORM_1,&norm);
CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"One norm of matrix %g\n",(double)norm);
CHKERRQ(ierr);
ierr = MatNorm(C,NORM_INFINITY,&norm);
CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"Infinity norm of matrix %g\n",(double)norm);
CHKERRQ(ierr);
ierr = MatFactorInfoInitialize(&info);
CHKERRQ(ierr);
info.fill = 2.0;
info.dtcol = 0.0;
info.zeropivot = 1.e-14;
info.pivotinblocks = 1.0;
ierr = MatLUFactor(C,perm,iperm,&info);
CHKERRQ(ierr);
/* Test MatSolve */
ierr = MatSolve(C,b,x);
CHKERRQ(ierr);
ierr = VecView(b,PETSC_VIEWER_STDOUT_SELF);
CHKERRQ(ierr);
ierr = VecView(x,PETSC_VIEWER_STDOUT_SELF);
CHKERRQ(ierr);
ierr = VecAXPY(x,-1.0,u);
CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);
CHKERRQ(ierr);
if (norm > tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"MatSolve: Norm of error %g\n",(double)norm);
CHKERRQ(ierr);
}
/* Test MatSolveAdd */
ierr = MatSolveAdd(C,b,y,x);
CHKERRQ(ierr);
ierr = VecAXPY(x,-1.0,y);
CHKERRQ(ierr);
ierr = VecAXPY(x,-1.0,u);
CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);
CHKERRQ(ierr);
if (norm > tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"MatSolveAdd(): Norm of error %g\n",(double)norm);
CHKERRQ(ierr);
}
ierr = ISDestroy(&perm);
CHKERRQ(ierr);
ierr = ISDestroy(&iperm);
CHKERRQ(ierr);
ierr = VecDestroy(&u);
CHKERRQ(ierr);
ierr = VecDestroy(&y);
CHKERRQ(ierr);
ierr = VecDestroy(&b);
CHKERRQ(ierr);
ierr = VecDestroy(&x);
CHKERRQ(ierr);
ierr = MatDestroy(&C);
CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
PetscErrorCode RHSJacobian(TS ts, PetscReal t, Vec X, Mat J, Mat B, void *ptr)
{
AppCtx *user = (AppCtx*)ptr;
PetscInt nb_cells, i, idx;
PetscReal alpha, beta;
PetscReal mu_a, D_a;
PetscReal mu_h, D_h;
PetscReal a, h;
const PetscScalar *x;
PetscScalar va[4], vh[4];
PetscInt ca[4], ch[4], rowa, rowh;
PetscErrorCode ierr;
PetscFunctionBegin;
nb_cells = user->nb_cells;
alpha = user->alpha;
beta = user->beta;
mu_a = user->mu_a;
D_a = user->D_a;
mu_h = user->mu_h;
D_h = user->D_h;
ierr = VecGetArrayRead(X, &x);CHKERRQ(ierr);
for(i = 0; i < nb_cells ; ++i) {
rowa = 2*i;
rowh = 2*i+1;
a = x[2*i];
h = x[2*i+1];
ca[0] = ch[1] = 2*i;
va[0] = 2*alpha*a / (1.+beta*h) - mu_a;
vh[1] = 2*alpha*a;
ca[1] = ch[0] = 2*i+1;
va[1] = -beta*alpha*a*a / ((1.+beta*h)*(1.+beta*h));
vh[0] = -mu_h;
idx = 2;
if(i > 0) {
ca[idx] = 2*(i-1);
ch[idx] = 2*(i-1)+1;
va[idx] = D_a;
vh[idx] = D_h;
va[0] -= D_a;
vh[0] -= D_h;
idx++;
}
if(i < nb_cells-1) {
ca[idx] = 2*(i+1);
ch[idx] = 2*(i+1)+1;
va[idx] = D_a;
vh[idx] = D_h;
va[0] -= D_a;
vh[0] -= D_h;
idx++;
}
ierr = MatSetValues(B, 1, &rowa, idx, ca, va, INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(B, 1, &rowh, idx, ch, vh, INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecRestoreArrayRead(X, &x);CHKERRQ(ierr);
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (J != B) {
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
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,NULL, "-test_zheevx", &flg);CHKERRQ(ierr);
if (flg) {
TestZHEEV = PETSC_FALSE;
TestZHEEVX = PETSC_TRUE;
}
ierr = PetscOptionsHasName(NULL,NULL, "-test_zhegv", &flg);CHKERRQ(ierr);
if (flg) {
TestZHEEV = PETSC_FALSE;
TestZHEGV = PETSC_TRUE;
}
ierr = PetscOptionsHasName(NULL,NULL, "-test_zhegvx", &flg);CHKERRQ(ierr);
if (flg) {
TestZHEEV = PETSC_FALSE;
TestZHEGVX = PETSC_TRUE;
}
ierr = PetscOptionsGetReal(NULL,NULL,"-sigma1",&sigma1,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,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,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,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 = PetscMalloc1(n,&evals);CHKERRQ(ierr);
ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
ierr = MatDenseGetArray(A_dense,&arrayA);CHKERRQ(ierr);
if (TestZHEEV) { /* test zheev() */
printf(" LAPACKsyev: compute all %d eigensolutions...\n",m);
ierr = PetscMalloc1(3*n-2,&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 = PetscMalloc1(m*n+1,&evecs_array);CHKERRQ(ierr);
ierr = PetscMalloc1(7*n+1,&rwork);CHKERRQ(ierr);
ierr = PetscMalloc1(5*n+1,&iwork);CHKERRQ(ierr);
ierr = PetscMalloc1(n+1,&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 = PetscMalloc1(3*n+1,&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 = PetscMalloc1(m*n+1,&evecs_array);CHKERRQ(ierr);
ierr = PetscMalloc1(6*n+1,&iwork);CHKERRQ(ierr);
ifail = iwork + 5*n;
ierr = PetscMalloc1(7*n+1,&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,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,(double)evals[i]);
}
/* Check residuals and orthogonality */
ierr = PetscMalloc1(nevs+1,&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)
{
Mat A; /* problem matrix */
EPS eps; /* eigenproblem solver context */
EPSType type;
PetscReal error,tol,re,im;
PetscScalar kr,ki,value[3];
Vec xr,xi;
PetscInt n=30,i,Istart,Iend,col[3],nev,maxit,its,nconv;
PetscBool FirstBlock=PETSC_FALSE,LastBlock=PETSC_FALSE;
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n1-D Laplacian Eigenproblem, n=%D\n\n",n);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the operator matrix that defines the eigensystem, Ax=kx
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
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 = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
if (Istart==0) FirstBlock=PETSC_TRUE;
if (Iend==n) LastBlock=PETSC_TRUE;
value[0]=-1.0; value[1]=2.0; value[2]=-1.0;
for (i=(FirstBlock? Istart+1: Istart); i<(LastBlock? Iend-1: Iend); i++) {
col[0]=i-1; col[1]=i; col[2]=i+1;
ierr = MatSetValues(A,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
if (LastBlock) {
i=n-1; col[0]=n-2; col[1]=n-1;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
if (FirstBlock) {
i=0; col[0]=0; col[1]=1; value[0]=2.0; value[1]=-1.0;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatGetVecs(A,NULL,&xr);CHKERRQ(ierr);
ierr = MatGetVecs(A,NULL,&xi);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create eigensolver context
*/
ierr = EPSCreate(PETSC_COMM_WORLD,&eps);CHKERRQ(ierr);
/*
Set operators. In this case, it is a standard eigenvalue problem
*/
ierr = EPSSetOperators(eps,A,NULL);CHKERRQ(ierr);
ierr = EPSSetProblemType(eps,EPS_HEP);CHKERRQ(ierr);
/*
Set solver parameters at runtime
*/
ierr = EPSSetFromOptions(eps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the eigensystem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = EPSSolve(eps);CHKERRQ(ierr);
/*
Optional: Get some information from the solver and display it
*/
ierr = EPSGetIterationNumber(eps,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %D\n",its);CHKERRQ(ierr);
ierr = EPSGetType(eps,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Solution method: %s\n\n",type);CHKERRQ(ierr);
ierr = EPSGetDimensions(eps,&nev,NULL,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of requested eigenvalues: %D\n",nev);CHKERRQ(ierr);
ierr = EPSGetTolerances(eps,&tol,&maxit);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Stopping condition: tol=%.4g, maxit=%D\n",(double)tol,maxit);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Get number of converged approximate eigenpairs
*/
ierr = EPSGetConverged(eps,&nconv);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of converged eigenpairs: %D\n\n",nconv);CHKERRQ(ierr);
if (nconv>0) {
/*
Display eigenvalues and relative errors
*/
ierr = PetscPrintf(PETSC_COMM_WORLD,
" k ||Ax-kx||/||kx||\n"
" ----------------- ------------------\n");CHKERRQ(ierr);
for (i=0;i<nconv;i++) {
/*
Get converged eigenpairs: i-th eigenvalue is stored in kr (real part) and
ki (imaginary part)
*/
ierr = EPSGetEigenpair(eps,i,&kr,&ki,xr,xi);CHKERRQ(ierr);
/*
Compute the relative error associated to each eigenpair
*/
ierr = EPSComputeRelativeError(eps,i,&error);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
re = PetscRealPart(kr);
im = PetscImaginaryPart(kr);
#else
re = kr;
im = ki;
#endif
if (im!=0.0) {
ierr = PetscPrintf(PETSC_COMM_WORLD," %9f%+9f j %12g\n",(double)re,(double)im,(double)error);CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_WORLD," %12f %12g\n",(double)re,(double)error);CHKERRQ(ierr);
}
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n");CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = EPSDestroy(&eps);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&xr);CHKERRQ(ierr);
ierr = VecDestroy(&xi);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
void PetscMatrix<Scalar>::finish()
{
MatAssemblyBegin(matrix, MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(matrix, MAT_FINAL_ASSEMBLY);
}
int main(int argc,char **args)
{
Mat A,B,C;
PetscInt i,j,k,m = 3,n = 3,bs = 1;
PetscErrorCode ierr;
PetscMPIInt size;
ierr = PetscInitialize(&argc,&args,(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,"This is a uniprocessor example only!");
ierr = PetscOptionsGetInt(NULL,NULL,"-m",&m,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-bs",&bs,NULL);CHKERRQ(ierr);
/* adjust sizes by block size */
if (m%bs) m += bs-m%bs;
if (n%bs) n += bs-n%bs;
ierr = MatCreate(PETSC_COMM_SELF,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,m*n,m*n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
ierr = MatSetBlockSize(A,bs);CHKERRQ(ierr);
ierr = MatSetType(A,MATSEQAIJ);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_SELF,&B);CHKERRQ(ierr);
ierr = MatSetSizes(B,m*n,m*n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
ierr = MatSetBlockSize(B,bs);CHKERRQ(ierr);
ierr = MatSetType(B,MATSEQBAIJ);CHKERRQ(ierr);
ierr = MatSetUp(B);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_SELF,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,m*n,m*n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
ierr = MatSetBlockSize(C,bs);CHKERRQ(ierr);
ierr = MatSetType(C,MATSEQSBAIJ);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
ierr = MatSetOption(C,MAT_IGNORE_LOWER_TRIANGULAR,PETSC_TRUE);CHKERRQ(ierr);
for (i=0; i<m; i++) {
for (j=0; j<n; j++) {
PetscScalar v = -1.0;
PetscInt Ii = j + n*i,J;
J = Ii - n;
if (J>=0) {
ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(B,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);
}
J = Ii + n;
if (J<m*n) {
ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(B,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);
}
J = Ii - 1;
if (J>=0) {
ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(B,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);
}
J = Ii + 1;
if (J<m*n) {
ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(B,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);
}
v = 4.0;
ierr = MatSetValues(A,1,&Ii,1,&Ii,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(B,1,&Ii,1,&Ii,&v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(C,1,&Ii,1,&Ii,&v,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* test MatGetRowIJ for the three Mat types */
ierr = MatView(A,NULL);CHKERRQ(ierr);
ierr = MatView(B,NULL);CHKERRQ(ierr);
ierr = MatView(C,NULL);CHKERRQ(ierr);
for (i=0;i<2;i++) {
PetscInt shift = i;
for (j=0;j<2;j++) {
PetscBool symmetric = ((j>0) ? PETSC_FALSE : PETSC_TRUE);
for (k=0;k<2;k++) {
PetscBool compressed = ((k>0) ? PETSC_FALSE : PETSC_TRUE);
ierr = DumpCSR(A,shift,symmetric,compressed);CHKERRQ(ierr);
ierr = DumpCSR(B,shift,symmetric,compressed);CHKERRQ(ierr);
ierr = DumpCSR(C,shift,symmetric,compressed);CHKERRQ(ierr);
}
}
}
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **args)
{
Mat C;
PetscErrorCode ierr;
PetscInt N = 2,rowidx,colidx;
Vec u,b,r;
KSP ksp;
PetscReal norm;
PetscMPIInt rank,size;
PetscScalar v;
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
/* create stiffness matrix C = [1 2; 2 3] */
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);
if (!rank) {
rowidx = 0; colidx = 0; v = 1.0;
ierr = MatSetValues(C,1,&rowidx,1,&colidx,&v,INSERT_VALUES);CHKERRQ(ierr);
rowidx = 0; colidx = 1; v = 2.0;
ierr = MatSetValues(C,1,&rowidx,1,&colidx,&v,INSERT_VALUES);CHKERRQ(ierr);
rowidx = 1; colidx = 0; v = 2.0;
ierr = MatSetValues(C,1,&rowidx,1,&colidx,&v,INSERT_VALUES);CHKERRQ(ierr);
rowidx = 1; colidx = 1; v = 3.0;
ierr = MatSetValues(C,1,&rowidx,1,&colidx,&v,INSERT_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 */
ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr);
ierr = VecSetSizes(u,PETSC_DECIDE,N);CHKERRQ(ierr);
ierr = VecSetFromOptions(u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b);CHKERRQ(ierr);
ierr = VecDuplicate(u,&r);CHKERRQ(ierr);
ierr = VecSet(u,0.0);CHKERRQ(ierr);
ierr = VecSet(b,1.0);CHKERRQ(ierr);
/* solve linear system C*u = b */
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,C,C);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = KSPSolve(ksp,b,u);CHKERRQ(ierr);
/* check residual r = C*u - b */
ierr = MatMult(C,u,r);CHKERRQ(ierr);
ierr = VecAXPY(r,-1.0,b);CHKERRQ(ierr);
ierr = VecNorm(r,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"|| C*u - b|| = %g\n",(double)norm);CHKERRQ(ierr);
/* solve C^T*u = b twice */
ierr = KSPSolveTranspose(ksp,b,u);CHKERRQ(ierr);
/* check residual r = C^T*u - b */
ierr = MatMultTranspose(C,u,r);CHKERRQ(ierr);
ierr = VecAXPY(r,-1.0,b);CHKERRQ(ierr);
ierr = VecNorm(r,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"|| C^T*u - b|| = %g\n",(double)norm);CHKERRQ(ierr);
ierr = KSPSolveTranspose(ksp,b,u);CHKERRQ(ierr);
ierr = MatMultTranspose(C,u,r);CHKERRQ(ierr);
ierr = VecAXPY(r,-1.0,b);CHKERRQ(ierr);
ierr = VecNorm(r,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"|| C^T*u - b|| = %g\n",(double)norm);CHKERRQ(ierr);
/* solve C*u = b again */
ierr = KSPSolve(ksp,b,u);CHKERRQ(ierr);
ierr = MatMult(C,u,r);CHKERRQ(ierr);
ierr = VecAXPY(r,-1.0,b);CHKERRQ(ierr);
ierr = VecNorm(r,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"|| C*u - b|| = %g\n",(double)norm);CHKERRQ(ierr);
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode MatDisAssemble_MPISBAIJ(Mat A)
{
Mat_MPISBAIJ *baij = (Mat_MPISBAIJ*)A->data;
Mat B = baij->B,Bnew;
Mat_SeqBAIJ *Bbaij = (Mat_SeqBAIJ*)B->data;
PetscErrorCode ierr;
PetscInt i,j,mbs=Bbaij->mbs,n = A->cmap->N,col,*garray=baij->garray;
PetscInt k,bs=A->rmap->bs,bs2=baij->bs2,*rvals,*nz,ec,m=A->rmap->n;
MatScalar *a = Bbaij->a;
PetscScalar *atmp;
#if defined(PETSC_USE_REAL_MAT_SINGLE)
PetscInt l;
#endif
PetscFunctionBegin;
#if defined(PETSC_USE_REAL_MAT_SINGLE)
ierr = PetscMalloc(A->rmap->bs*sizeof(PetscScalar),&atmp);
#endif
/* free stuff related to matrix-vec multiply */
ierr = VecGetSize(baij->lvec,&ec);CHKERRQ(ierr); /* needed for PetscLogObjectMemory below */
ierr = VecDestroy(&baij->lvec);CHKERRQ(ierr);
ierr = VecScatterDestroy(&baij->Mvctx);CHKERRQ(ierr);
ierr = VecDestroy(&baij->slvec0);CHKERRQ(ierr);
ierr = VecDestroy(&baij->slvec0b);CHKERRQ(ierr);
ierr = VecDestroy(&baij->slvec1);CHKERRQ(ierr);
ierr = VecDestroy(&baij->slvec1a);CHKERRQ(ierr);
ierr = VecDestroy(&baij->slvec1b);CHKERRQ(ierr);
if (baij->colmap) {
#if defined (PETSC_USE_CTABLE)
ierr = PetscTableDestroy(&baij->colmap);CHKERRQ(ierr);
#else
ierr = PetscFree(baij->colmap);CHKERRQ(ierr);
ierr = PetscLogObjectMemory(A,-Bbaij->nbs*sizeof(PetscInt));CHKERRQ(ierr);
#endif
}
/* make sure that B is assembled so we can access its values */
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* invent new B and copy stuff over */
ierr = PetscMalloc(mbs*sizeof(PetscInt),&nz);CHKERRQ(ierr);
for (i=0; i<mbs; i++) {
nz[i] = Bbaij->i[i+1]-Bbaij->i[i];
}
ierr = MatCreate(PETSC_COMM_SELF,&Bnew);CHKERRQ(ierr);
ierr = MatSetSizes(Bnew,m,n,m,n);CHKERRQ(ierr);
ierr = MatSetType(Bnew,((PetscObject)B)->type_name);CHKERRQ(ierr);
ierr = MatSeqBAIJSetPreallocation(Bnew,B->rmap->bs,0,nz);CHKERRQ(ierr);
((Mat_SeqSBAIJ*)Bnew->data)->nonew = Bbaij->nonew; /* Inherit insertion error options. */
ierr = PetscFree(nz);CHKERRQ(ierr);
ierr = PetscMalloc(bs*sizeof(PetscInt),&rvals);CHKERRQ(ierr);
for (i=0; i<mbs; i++) {
rvals[0] = bs*i;
for (j=1; j<bs; j++) { rvals[j] = rvals[j-1] + 1; }
for (j=Bbaij->i[i]; j<Bbaij->i[i+1]; j++) {
col = garray[Bbaij->j[j]]*bs;
for (k=0; k<bs; k++) {
#if defined(PETSC_USE_REAL_MAT_SINGLE)
for (l=0; l<bs; l++) atmp[l] = a[j*bs2+l];
#else
atmp = a+j*bs2 + k*bs;
#endif
ierr = MatSetValues_SeqSBAIJ(Bnew,bs,rvals,1,&col,atmp,B->insertmode);CHKERRQ(ierr);
col++;
}
}
}
#if defined(PETSC_USE_REAL_MAT_SINGLE)
ierr = PetscFree(atmp);CHKERRQ(ierr);
#endif
ierr = PetscFree(baij->garray);CHKERRQ(ierr);
baij->garray = 0;
ierr = PetscFree(rvals);CHKERRQ(ierr);
ierr = PetscLogObjectMemory(A,-ec*sizeof(PetscInt));CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = PetscLogObjectParent(A,Bnew);CHKERRQ(ierr);
baij->B = Bnew;
A->was_assembled = PETSC_FALSE;
PetscFunctionReturn(0);
}
PetscErrorCode ResidualJacobian(SNES snes,Vec X,Mat J,Mat B,void *ctx)
{
PetscErrorCode ierr;
Userctx *user=(Userctx*)ctx;
Vec Xgen,Xnet;
PetscScalar *xgen,*xnet;
PetscInt i,idx=0;
PetscScalar Vr,Vi,Vm,Vm2;
PetscScalar Eqp,Edp,delta; /* Generator variables */
PetscScalar Efd;
PetscScalar Id,Iq; /* Generator dq axis currents */
PetscScalar Vd,Vq;
PetscScalar val[10];
PetscInt row[2],col[10];
PetscInt net_start=user->neqs_gen;
PetscFunctionBegin;
ierr = MatZeroEntries(B);CHKERRQ(ierr);
ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,X,Xgen,Xnet);CHKERRQ(ierr);
ierr = VecGetArray(Xgen,&xgen);CHKERRQ(ierr);
ierr = VecGetArray(Xnet,&xnet);CHKERRQ(ierr);
/* Generator subsystem */
for (i=0; i < ngen; i++) {
Eqp = xgen[idx];
Edp = xgen[idx+1];
delta = xgen[idx+2];
Id = xgen[idx+4];
Iq = xgen[idx+5];
Efd = xgen[idx+6];
/* fgen[idx] = (Eqp + (Xd[i] - Xdp[i])*Id - Efd)/Td0p[i]; */
row[0] = idx;
col[0] = idx; col[1] = idx+4; col[2] = idx+6;
val[0] = 1/ Td0p[i]; val[1] = (Xd[i] - Xdp[i])/ Td0p[i]; val[2] = -1/Td0p[i];
ierr = MatSetValues(J,1,row,3,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* fgen[idx+1] = (Edp - (Xq[i] - Xqp[i])*Iq)/Tq0p[i]; */
row[0] = idx + 1;
col[0] = idx + 1; col[1] = idx+5;
val[0] = 1/Tq0p[i]; val[1] = -(Xq[i] - Xqp[i])/Tq0p[i];
ierr = MatSetValues(J,1,row,2,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* fgen[idx+2] = - w + w_s; */
row[0] = idx + 2;
col[0] = idx + 2; col[1] = idx + 3;
val[0] = 0; val[1] = -1;
ierr = MatSetValues(J,1,row,2,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* fgen[idx+3] = (-TM[i] + Edp*Id + Eqp*Iq + (Xqp[i] - Xdp[i])*Id*Iq + D[i]*(w - w_s))/M[i]; */
row[0] = idx + 3;
col[0] = idx; col[1] = idx + 1; col[2] = idx + 3; col[3] = idx + 4; col[4] = idx + 5;
val[0] = Iq/M[i]; val[1] = Id/M[i]; val[2] = D[i]/M[i]; val[3] = (Edp + (Xqp[i]-Xdp[i])*Iq)/M[i]; val[4] = (Eqp + (Xqp[i] - Xdp[i])*Id)/M[i];
ierr = MatSetValues(J,1,row,5,col,val,INSERT_VALUES);CHKERRQ(ierr);
Vr = xnet[2*gbus[i]]; /* Real part of generator terminal voltage */
Vi = xnet[2*gbus[i]+1]; /* Imaginary part of the generator terminal voltage */
ierr = ri2dq(Vr,Vi,delta,&Vd,&Vq);CHKERRQ(ierr);
PetscScalar Zdq_inv[4],det;
det = Rs[i]*Rs[i] + Xdp[i]*Xqp[i];
Zdq_inv[0] = Rs[i]/det;
Zdq_inv[1] = Xqp[i]/det;
Zdq_inv[2] = -Xdp[i]/det;
Zdq_inv[3] = Rs[i]/det;
PetscScalar dVd_dVr,dVd_dVi,dVq_dVr,dVq_dVi,dVd_ddelta,dVq_ddelta;
dVd_dVr = PetscSinScalar(delta); dVd_dVi = -PetscCosScalar(delta);
dVq_dVr = PetscCosScalar(delta); dVq_dVi = PetscSinScalar(delta);
dVd_ddelta = Vr*PetscCosScalar(delta) + Vi*PetscSinScalar(delta);
dVq_ddelta = -Vr*PetscSinScalar(delta) + Vi*PetscCosScalar(delta);
/* fgen[idx+4] = Zdq_inv[0]*(-Edp + Vd) + Zdq_inv[1]*(-Eqp + Vq) + Id; */
row[0] = idx+4;
col[0] = idx; col[1] = idx+1; col[2] = idx + 2;
val[0] = -Zdq_inv[1]; val[1] = -Zdq_inv[0]; val[2] = Zdq_inv[0]*dVd_ddelta + Zdq_inv[1]*dVq_ddelta;
col[3] = idx + 4; col[4] = net_start+2*gbus[i]; col[5] = net_start + 2*gbus[i]+1;
val[3] = 1; val[4] = Zdq_inv[0]*dVd_dVr + Zdq_inv[1]*dVq_dVr; val[5] = Zdq_inv[0]*dVd_dVi + Zdq_inv[1]*dVq_dVi;
ierr = MatSetValues(J,1,row,6,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* fgen[idx+5] = Zdq_inv[2]*(-Edp + Vd) + Zdq_inv[3]*(-Eqp + Vq) + Iq; */
row[0] = idx+5;
col[0] = idx; col[1] = idx+1; col[2] = idx + 2;
val[0] = -Zdq_inv[3]; val[1] = -Zdq_inv[2]; val[2] = Zdq_inv[2]*dVd_ddelta + Zdq_inv[3]*dVq_ddelta;
col[3] = idx + 5; col[4] = net_start+2*gbus[i]; col[5] = net_start + 2*gbus[i]+1;
val[3] = 1; val[4] = Zdq_inv[2]*dVd_dVr + Zdq_inv[3]*dVq_dVr; val[5] = Zdq_inv[2]*dVd_dVi + Zdq_inv[3]*dVq_dVi;
ierr = MatSetValues(J,1,row,6,col,val,INSERT_VALUES);CHKERRQ(ierr);
PetscScalar dIGr_ddelta,dIGi_ddelta,dIGr_dId,dIGr_dIq,dIGi_dId,dIGi_dIq;
dIGr_ddelta = Id*PetscCosScalar(delta) - Iq*PetscSinScalar(delta);
dIGi_ddelta = Id*PetscSinScalar(delta) + Iq*PetscCosScalar(delta);
dIGr_dId = PetscSinScalar(delta); dIGr_dIq = PetscCosScalar(delta);
dIGi_dId = -PetscCosScalar(delta); dIGi_dIq = PetscSinScalar(delta);
/* fnet[2*gbus[i]] -= IGi; */
row[0] = net_start + 2*gbus[i];
col[0] = idx+2; col[1] = idx + 4; col[2] = idx + 5;
val[0] = -dIGi_ddelta; val[1] = -dIGi_dId; val[2] = -dIGi_dIq;
ierr = MatSetValues(J,1,row,3,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* fnet[2*gbus[i]+1] -= IGr; */
row[0] = net_start + 2*gbus[i]+1;
col[0] = idx+2; col[1] = idx + 4; col[2] = idx + 5;
val[0] = -dIGr_ddelta; val[1] = -dIGr_dId; val[2] = -dIGr_dIq;
ierr = MatSetValues(J,1,row,3,col,val,INSERT_VALUES);CHKERRQ(ierr);
Vm = PetscSqrtScalar(Vd*Vd + Vq*Vq); Vm2 = Vm*Vm;
/* fgen[idx+6] = (KE[i]*Efd + SE - VR)/TE[i]; */
/* SE = k1[i]*PetscExpScalar(k2[i]*Efd); */
PetscScalar dSE_dEfd;
dSE_dEfd = k1[i]*k2[i]*PetscExpScalar(k2[i]*Efd);
row[0] = idx + 6;
col[0] = idx + 6; col[1] = idx + 8;
val[0] = (KE[i] + dSE_dEfd)/TE[i]; val[1] = -1/TE[i];
ierr = MatSetValues(J,1,row,2,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* Exciter differential equations */
/* fgen[idx+7] = (RF - KF[i]*Efd/TF[i])/TF[i]; */
row[0] = idx + 7;
col[0] = idx + 6; col[1] = idx + 7;
val[0] = (-KF[i]/TF[i])/TF[i]; val[1] = 1/TF[i];
ierr = MatSetValues(J,1,row,2,col,val,INSERT_VALUES);CHKERRQ(ierr);
/* fgen[idx+8] = (VR - KA[i]*RF + KA[i]*KF[i]*Efd/TF[i] - KA[i]*(Vref[i] - Vm))/TA[i]; */
/* Vm = (Vd^2 + Vq^2)^0.5; */
PetscScalar dVm_dVd,dVm_dVq,dVm_dVr,dVm_dVi;
dVm_dVd = Vd/Vm; dVm_dVq = Vq/Vm;
dVm_dVr = dVm_dVd*dVd_dVr + dVm_dVq*dVq_dVr;
dVm_dVi = dVm_dVd*dVd_dVi + dVm_dVq*dVq_dVi;
row[0] = idx + 8;
col[0] = idx + 6; col[1] = idx + 7; col[2] = idx + 8;
val[0] = (KA[i]*KF[i]/TF[i])/TA[i]; val[1] = -KA[i]/TA[i]; val[2] = 1/TA[i];
col[3] = net_start + 2*gbus[i]; col[4] = net_start + 2*gbus[i]+1;
val[3] = KA[i]*dVm_dVr/TA[i]; val[4] = KA[i]*dVm_dVi/TA[i];
ierr = MatSetValues(J,1,row,5,col,val,INSERT_VALUES);CHKERRQ(ierr);
idx = idx + 9;
}
PetscInt ncols;
const PetscInt *cols;
const PetscScalar *yvals;
PetscInt k;
for (i=0; i<nbus; i++) {
ierr = MatGetRow(user->Ybus,2*i,&ncols,&cols,&yvals);CHKERRQ(ierr);
row[0] = net_start + 2*i;
for (k=0; k<ncols; k++) {
col[k] = net_start + cols[k];
val[k] = yvals[k];
}
ierr = MatSetValues(J,1,row,ncols,col,val,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(user->Ybus,2*i,&ncols,&cols,&yvals);CHKERRQ(ierr);
ierr = MatGetRow(user->Ybus,2*i+1,&ncols,&cols,&yvals);CHKERRQ(ierr);
row[0] = net_start + 2*i+1;
for (k=0; k<ncols; k++) {
col[k] = net_start + cols[k];
val[k] = yvals[k];
}
ierr = MatSetValues(J,1,row,ncols,col,val,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(user->Ybus,2*i+1,&ncols,&cols,&yvals);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(J,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
PetscScalar PD,QD,Vm0,*v0,Vm4;
PetscScalar dPD_dVr,dPD_dVi,dQD_dVr,dQD_dVi;
PetscScalar dIDr_dVr,dIDr_dVi,dIDi_dVr,dIDi_dVi;
ierr = VecGetArray(user->V0,&v0);CHKERRQ(ierr);
for (i=0; i < nload; i++) {
Vr = xnet[2*lbus[i]]; /* Real part of load bus voltage */
Vi = xnet[2*lbus[i]+1]; /* Imaginary part of the load bus voltage */
Vm = PetscSqrtScalar(Vr*Vr + Vi*Vi); Vm2 = Vm*Vm; Vm4 = Vm2*Vm2;
Vm0 = PetscSqrtScalar(v0[2*lbus[i]]*v0[2*lbus[i]] + v0[2*lbus[i]+1]*v0[2*lbus[i]+1]);
PD = QD = 0.0;
dPD_dVr = dPD_dVi = dQD_dVr = dQD_dVi = 0.0;
for (k=0; k < ld_nsegsp[i]; k++) {
PD += ld_alphap[k]*PD0[i]*PetscPowScalar((Vm/Vm0),ld_betap[k]);
dPD_dVr += ld_alphap[k]*ld_betap[k]*PD0[i]*PetscPowScalar((1/Vm0),ld_betap[k])*Vr*PetscPowScalar(Vm,(ld_betap[k]-2));
dPD_dVi += ld_alphap[k]*ld_betap[k]*PD0[i]*PetscPowScalar((1/Vm0),ld_betap[k])*Vi*PetscPowScalar(Vm,(ld_betap[k]-2));
}
for (k=0; k < ld_nsegsq[i]; k++) {
QD += ld_alphaq[k]*QD0[i]*PetscPowScalar((Vm/Vm0),ld_betaq[k]);
dQD_dVr += ld_alphaq[k]*ld_betaq[k]*QD0[i]*PetscPowScalar((1/Vm0),ld_betaq[k])*Vr*PetscPowScalar(Vm,(ld_betaq[k]-2));
dQD_dVi += ld_alphaq[k]*ld_betaq[k]*QD0[i]*PetscPowScalar((1/Vm0),ld_betaq[k])*Vi*PetscPowScalar(Vm,(ld_betaq[k]-2));
}
/* IDr = (PD*Vr + QD*Vi)/Vm2; */
/* IDi = (-QD*Vr + PD*Vi)/Vm2; */
dIDr_dVr = (dPD_dVr*Vr + dQD_dVr*Vi + PD)/Vm2 - ((PD*Vr + QD*Vi)*2*Vr)/Vm4;
dIDr_dVi = (dPD_dVi*Vr + dQD_dVi*Vi + QD)/Vm2 - ((PD*Vr + QD*Vi)*2*Vi)/Vm4;
dIDi_dVr = (-dQD_dVr*Vr + dPD_dVr*Vi - QD)/Vm2 - ((-QD*Vr + PD*Vi)*2*Vr)/Vm4;
dIDi_dVi = (-dQD_dVi*Vr + dPD_dVi*Vi + PD)/Vm2 - ((-QD*Vr + PD*Vi)*2*Vi)/Vm4;
/* fnet[2*lbus[i]] += IDi; */
row[0] = net_start + 2*lbus[i];
col[0] = net_start + 2*lbus[i]; col[1] = net_start + 2*lbus[i]+1;
val[0] = dIDi_dVr; val[1] = dIDi_dVi;
ierr = MatSetValues(J,1,row,2,col,val,ADD_VALUES);CHKERRQ(ierr);
/* fnet[2*lbus[i]+1] += IDr; */
row[0] = net_start + 2*lbus[i]+1;
col[0] = net_start + 2*lbus[i]; col[1] = net_start + 2*lbus[i]+1;
val[0] = dIDr_dVr; val[1] = dIDr_dVi;
ierr = MatSetValues(J,1,row,2,col,val,ADD_VALUES);CHKERRQ(ierr);
}
ierr = VecRestoreArray(user->V0,&v0);CHKERRQ(ierr);
ierr = VecRestoreArray(Xgen,&xgen);CHKERRQ(ierr);
ierr = VecRestoreArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int
PetscSparseMtrx :: assembleBegin()
{
return MatAssemblyBegin(this->mtrx, MAT_FINAL_ASSEMBLY);
}