PetscErrorCode SetPressureBC( FluidField f )
{
int i,j;
PetscReal **mask, m;
PetscReal ***rhs,p;
DALocalInfo g;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscInfo(0,"Entering SetPressureBC()"); CHKERRQ(ierr);
ierr = DAGetLocalInfo(f->daB, &g); CHKERRQ(ierr);
ierr = GridGet(f->mask, &mask); CHKERRQ(ierr);
ierr = DAVecGetArrayDOF(f->daV,f->rhs,&rhs); CHKERRQ(ierr);
for (j = g.ys; j < g.ys+g.ym; ++j) {
for (i = g.xs; i < g.xs+g.xm; ++i) {
m = mask[j][i];
if( m > -1.5 ) continue;
if( PetscAbs(m+2) < .01 ) p = 20;
if( PetscAbs(m+3) < .01 ) p = 19;
if( PetscAbs(m+4) < .01 ) p = 10;
rhs[j][i][CELL_CENTER] = p;
}
}
ierr = DAVecRestoreArrayDOF(f->daV,f->rhs,&rhs); CHKERRQ(ierr);
ierr = PetscInfo(0,"Exiting SetPressureBC()"); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
PetscLayoutSetUp - given a map where you have set either the global or local
size sets up the map so that it may be used.
Collective on MPI_Comm
Input Parameters:
. map - pointer to the map
Level: developer
Notes: Typical calling sequence
$ PetscLayoutCreate(MPI_Comm,PetscLayout *);
$ PetscLayoutSetBlockSize(PetscLayout,1);
$ PetscLayoutSetSize(PetscLayout,n) or PetscLayoutSetLocalSize(PetscLayout,N); or both
$ PetscLayoutSetUp(PetscLayout);
$ PetscLayoutGetSize(PetscLayout,PetscInt *);
If the local size, global size are already set and range exists then this does nothing.
.seealso: PetscLayoutSetLocalSize(), PetscLayoutSetSize(), PetscLayoutGetSize(), PetscLayoutGetLocalSize(), PetscLayout, PetscLayoutDestroy(),
PetscLayoutGetRange(), PetscLayoutGetRanges(), PetscLayoutSetBlockSize(), PetscLayoutGetBlockSize(), PetscLayoutCreate()
@*/
PetscErrorCode PetscLayoutSetUp(PetscLayout map)
{
PetscMPIInt rank,size;
PetscInt p;
PetscErrorCode ierr;
PetscFunctionBegin;
if ((map->n >= 0) && (map->N >= 0) && (map->range)) PetscFunctionReturn(0);
if (map->n > 0 && map->bs > 1) {
if (map->n % map->bs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Local matrix size %D must be divisible by blocksize %D",map->n,map->bs);
}
if (map->N > 0 && map->bs > 1) {
if (map->N % map->bs) SETERRQ2(map->comm,PETSC_ERR_PLIB,"Global matrix size %D must be divisible by blocksize %D",map->N,map->bs);
}
ierr = MPI_Comm_size(map->comm, &size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(map->comm, &rank);CHKERRQ(ierr);
if (map->n > 0) map->n = map->n/PetscAbs(map->bs);
if (map->N > 0) map->N = map->N/PetscAbs(map->bs);
ierr = PetscSplitOwnership(map->comm,&map->n,&map->N);CHKERRQ(ierr);
map->n = map->n*PetscAbs(map->bs);
map->N = map->N*PetscAbs(map->bs);
if (!map->range) {
ierr = PetscMalloc1(size+1, &map->range);CHKERRQ(ierr);
}
ierr = MPI_Allgather(&map->n, 1, MPIU_INT, map->range+1, 1, MPIU_INT, map->comm);CHKERRQ(ierr);
map->range[0] = 0;
for (p = 2; p <= size; p++) map->range[p] += map->range[p-1];
map->rstart = map->range[rank];
map->rend = map->range[rank+1];
PetscFunctionReturn(0);
}
/*@
MatCreateTranspose - Creates a new matrix object that behaves like A'
Collective on Mat
Input Parameter:
. A - the (possibly rectangular) matrix
Output Parameter:
. N - the matrix that represents A'
Level: intermediate
Notes:
The transpose A' is NOT actually formed! Rather the new matrix
object performs the matrix-vector product by using the MatMultTranspose() on
the original matrix
.seealso: MatCreateNormal(), MatMult(), MatMultTranspose(), MatCreate()
@*/
PetscErrorCode MatCreateTranspose(Mat A,Mat *N)
{
PetscErrorCode ierr;
PetscInt m,n;
Mat_Transpose *Na;
PetscFunctionBegin;
ierr = MatGetLocalSize(A,&m,&n);CHKERRQ(ierr);
ierr = MatCreate(PetscObjectComm((PetscObject)A),N);CHKERRQ(ierr);
ierr = MatSetSizes(*N,n,m,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
ierr = PetscLayoutSetUp((*N)->rmap);CHKERRQ(ierr);
ierr = PetscLayoutSetUp((*N)->cmap);CHKERRQ(ierr);
ierr = PetscObjectChangeTypeName((PetscObject)*N,MATTRANSPOSEMAT);CHKERRQ(ierr);
ierr = PetscNewLog(*N,&Na);CHKERRQ(ierr);
(*N)->data = (void*) Na;
ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
Na->A = A;
(*N)->ops->destroy = MatDestroy_Transpose;
(*N)->ops->mult = MatMult_Transpose;
(*N)->ops->multadd = MatMultAdd_Transpose;
(*N)->ops->multtranspose = MatMultTranspose_Transpose;
(*N)->ops->multtransposeadd = MatMultTransposeAdd_Transpose;
(*N)->ops->duplicate = MatDuplicate_Transpose;
(*N)->ops->getvecs = MatCreateVecs_Transpose;
(*N)->ops->axpy = MatAXPY_Transpose;
(*N)->assembled = PETSC_TRUE;
ierr = PetscObjectComposeFunction((PetscObject)(*N),"MatTransposeGetMat_C",MatTransposeGetMat_Transpose);CHKERRQ(ierr);
ierr = MatSetBlockSizes(*N,PetscAbs(A->cmap->bs),PetscAbs(A->rmap->bs));CHKERRQ(ierr);
ierr = MatSetUp(*N);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PetscDrawArrow_Image(PetscDraw draw,PetscReal xl,PetscReal yl,PetscReal xr,PetscReal yr,int c)
{
PetscImage img = (PetscImage)draw->data;
PetscFunctionBegin;
PetscDrawValidColor(c);
{
int x_1 = XTRANS(draw,img,xl), x_2 = XTRANS(draw,img,xr);
int y_1 = YTRANS(draw,img,yl), y_2 = YTRANS(draw,img,yr);
if (x_1 == x_2 && y_1 == y_2) PetscFunctionReturn(0);
PetscImageDrawLine(img,x_1,y_1,x_2,y_2,c);
if (x_1 == x_2 && PetscAbs(y_1 - y_2) > 7) {
if (y_2 > y_1) {
PetscImageDrawLine(img,x_2,y_2,x_2-3,y_2-3,c);
PetscImageDrawLine(img,x_2,y_2,x_2+3,y_2-3,c);
} else {
PetscImageDrawLine(img,x_2,y_2,x_2-3,y_2+3,c);
PetscImageDrawLine(img,x_2,y_2,x_2+3,y_2+3,c);
}
}
if (y_1 == y_2 && PetscAbs(x_1 - x_2) > 7) {
if (x_2 > x_1) {
PetscImageDrawLine(img,x_2-3,y_2-3,x_2,y_2,c);
PetscImageDrawLine(img,x_2-3,y_2+3,x_2,y_2,c);
} else {
PetscImageDrawLine(img,x_2,y_2,x_2+3,y_2-3,c);
PetscImageDrawLine(img,x_2,y_2,x_2+3,y_2+3,c);
}
}
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscInt degrees[1000],ndegrees,npoints,two;
PetscReal points[1000],weights[1000],interval[2];
PetscBool flg;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Discretization tools test options",NULL);CHKERRQ(ierr);
{
ndegrees = 1000;
degrees[0] = 0;
degrees[1] = 1;
degrees[2] = 2;
ierr = PetscOptionsIntArray("-degrees","list of degrees to evaluate","",degrees,&ndegrees,&flg);CHKERRQ(ierr);
if (!flg) ndegrees = 3;
npoints = 1000;
points[0] = 0.0;
points[1] = -0.5;
points[2] = 1.0;
ierr = PetscOptionsRealArray("-points","list of points at which to evaluate","",points,&npoints,&flg);CHKERRQ(ierr);
if (!flg) npoints = 3;
two = 2;
interval[0] = -1.;
interval[1] = 1.;
ierr = PetscOptionsRealArray("-interval","interval on which to construct quadrature","",interval,&two,NULL);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = CheckPoints("User-provided points",npoints,points,ndegrees,degrees);CHKERRQ(ierr);
ierr = PetscDTGaussQuadrature(npoints,interval[0],interval[1],points,weights);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Quadrature weights\n");CHKERRQ(ierr);
ierr = PetscRealView(npoints,weights,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
{
PetscReal a = interval[0],b = interval[1],zeroth,first,second;
PetscInt i;
zeroth = b - a;
first = (b*b - a*a)/2;
second = (b*b*b - a*a*a)/3;
for (i=0; i<npoints; i++) {
zeroth -= weights[i];
first -= weights[i] * points[i];
second -= weights[i] * PetscSqr(points[i]);
}
if (PetscAbs(zeroth) < 1e-10) zeroth = 0.;
if (PetscAbs(first) < 1e-10) first = 0.;
if (PetscAbs(second) < 1e-10) second = 0.;
ierr = PetscPrintf(PETSC_COMM_WORLD,"Moment error: zeroth=%g, first=%g, second=%g\n",(double)(-zeroth),(double)(-first),(double)(-second));CHKERRQ(ierr);
}
ierr = CheckPoints("Gauss points",npoints,points,ndegrees,degrees);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
PetscErrorCode VecView_Seq_Draw_LG(Vec xin,PetscViewer v)
{
PetscErrorCode ierr;
PetscInt i,c,bs = PetscAbs(xin->map->bs),n = xin->map->n/bs;
PetscDraw win;
PetscReal *xx;
PetscDrawLG lg;
const PetscScalar *xv;
PetscReal *yy;
PetscFunctionBegin;
ierr = PetscMalloc1(n,&xx);CHKERRQ(ierr);
ierr = PetscMalloc1(n,&yy);CHKERRQ(ierr);
ierr = VecGetArrayRead(xin,&xv);CHKERRQ(ierr);
for (c=0; c<bs; c++) {
ierr = PetscViewerDrawGetDrawLG(v,c,&lg);CHKERRQ(ierr);
ierr = PetscDrawLGGetDraw(lg,&win);CHKERRQ(ierr);
ierr = PetscDrawCheckResizedWindow(win);CHKERRQ(ierr);
ierr = PetscDrawLGReset(lg);CHKERRQ(ierr);
for (i=0; i<n; i++) {
xx[i] = (PetscReal) i;
yy[i] = PetscRealPart(xv[c + i*bs]);
}
ierr = PetscDrawLGAddPoints(lg,n,&xx,&yy);CHKERRQ(ierr);
ierr = PetscDrawLGDraw(lg);CHKERRQ(ierr);
ierr = PetscDrawSynchronizedFlush(win);CHKERRQ(ierr);
}
ierr = VecRestoreArrayRead(xin,&xv);CHKERRQ(ierr);
ierr = PetscFree(yy);CHKERRQ(ierr);
ierr = PetscFree(xx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
END_TEST
START_TEST( CreateGrid2D_test )
{
Grid2D g;
int count = 0;
PetscErrorCode ierr;
ierr = CreateGrid2D(8,8,&g); CHKERRQ(ierr);
for( int i = 0; i < g->d1; ++i)
{
for( int j = 0; j < g->d2; ++j)
{
g->v2[i][j] = count;
count++;
}
}
for (int i = 0; i < g->len; ++i)
{
fail_unless( PetscAbs(i-g->v1[i])<1e-9, "i:%d\t v:%f\n",i,g->v1[i]);
}
Bilinear2D(GridFunction2D_DerivX, g, 4.2, 4.3);
ierr = DestroyGrid2D(g); CHKERRQ(ierr);
}
PetscErrorCode VecView_Seq_Draw_LG(Vec xin,PetscViewer v)
{
PetscDraw draw;
PetscBool isnull;
PetscDrawLG lg;
PetscErrorCode ierr;
PetscInt i,c,bs = PetscAbs(xin->map->bs),n = xin->map->n/bs;
const PetscScalar *xv;
PetscReal *xx,*yy;
int colors[] = {PETSC_DRAW_RED};
PetscFunctionBegin;
ierr = PetscViewerDrawGetDraw(v,0,&draw);CHKERRQ(ierr);
ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr);
if (isnull) PetscFunctionReturn(0);
ierr = PetscMalloc2(n,&xx,n,&yy);CHKERRQ(ierr);
ierr = VecGetArrayRead(xin,&xv);CHKERRQ(ierr);
for (c=0; c<bs; c++) {
ierr = PetscViewerDrawGetDrawLG(v,c,&lg);CHKERRQ(ierr);
ierr = PetscDrawLGReset(lg);CHKERRQ(ierr);
ierr = PetscDrawLGSetDimension(lg,1);CHKERRQ(ierr);
ierr = PetscDrawLGSetColors(lg,colors);CHKERRQ(ierr);
for (i=0; i<n; i++) {
xx[i] = (PetscReal)i;
yy[i] = PetscRealPart(xv[c + i*bs]);
}
ierr = PetscDrawLGAddPoints(lg,n,&xx,&yy);CHKERRQ(ierr);
ierr = PetscDrawLGDraw(lg);CHKERRQ(ierr);
ierr = PetscDrawLGSave(lg);CHKERRQ(ierr);
}
ierr = VecRestoreArrayRead(xin,&xv);CHKERRQ(ierr);
ierr = PetscFree2(xx,yy);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode testCreate2D()
{
int ga;
DA da;
DALocalInfo info;
Vec vec;
PetscErrorCode ierr;
PetscFunctionBegin;
int d1 = 1453, d2 = 1451;
ierr = DACreate2d(PETSC_COMM_WORLD,DA_NONPERIODIC,DA_STENCIL_STAR,
d1,d2,PETSC_DECIDE,PETSC_DECIDE,1,1,0,0, &da); CHKERRQ(ierr);
ierr = DAGetLocalInfo(da,&info); CHKERRQ(ierr);
ierr = DACreateGlobalArray( da, &ga, &vec); CHKERRQ(ierr);
PetscReal **v;
ierr = DAVecGetArray(da,vec,&v); CHKERRQ(ierr);
int xe = info.xs+info.xm,
ye = info.ys+info.ym;
for (int j = info.ys; j < ye; ++j) {
for (int i = info.xs; i < xe; ++i) {
v[j][i] = 1.*i + d1 * j;
}
}
ierr = DAVecRestoreArray(da,vec,&v); CHKERRQ(ierr);
PetscPrintf(PETSC_COMM_WORLD,"Updated local portion with DAVec\n");
PetscBarrier(0);
{
double *da_ptr;
VecGetArray(vec, &da_ptr);
double *ptr;
int low[2],hi[2],ld;
NGA_Distribution(ga,GA_Nodeid(),low,hi);
NGA_Access(ga,low,hi,&ptr,&ld);
printf("[%d] ga:%p\tda:%p\tdiff:%p\n", GA_Nodeid(), ptr, da_ptr, (ptr-da_ptr) );
NGA_Release_update(ga,low,hi);
}
int lo[2],ld;
double val;
for (int j = 0; j < d2; ++j) {
for (int i = 0; i < d1; ++i) {
lo[0] = j;
lo[1] = i;
NGA_Get(ga,lo,lo,&val,&ld);
if( PetscAbs( i + d1*j - val) > .1 )
printf(".");
// printf("[%d] (%3.0f,%3.0f)\n", GA_Nodeid(), 1.*i + d1*j, val);
}
}
GA_Print_stats();
ierr = VecDestroy(vec); CHKERRQ(ierr);
GA_Destroy(ga);
PetscFunctionReturn(0);
}
static PetscErrorCode PetscDrawEllipse_X(PetscDraw Win, PetscReal x, PetscReal y, PetscReal a, PetscReal b, int c)
{
PetscDraw_X* XiWin = (PetscDraw_X*) Win->data;
int xA, yA, w, h;
PetscFunctionBegin;
PetscDrawXiSetColor(XiWin, c);
xA = XTRANS(Win, XiWin, x - a/2.0); w = XTRANS(Win, XiWin, x + a/2.0) - xA;
yA = YTRANS(Win, XiWin, y + b/2.0); h = PetscAbs(YTRANS(Win, XiWin, y - b/2.0) - yA);
XFillArc(XiWin->disp, PetscDrawXiDrawable(XiWin), XiWin->gc.set, xA, yA, w, h, 0, 23040);
PetscFunctionReturn(0);
}
PetscInt indexMaxAbs(PetscInt d, const PetscScalar x[]) {
PetscInt j=0;
PetscReal max=0.0;
for (int i=0; i < d; i++) {
const PetscReal tmp = PetscAbs(x[i]);
if (max < tmp) {
max = tmp;
j = i;
}
}
return j;
}
static PetscErrorCode VecDuplicate_MPI(Vec win,Vec *v)
{
PetscErrorCode ierr;
Vec_MPI *vw,*w = (Vec_MPI*)win->data;
PetscScalar *array;
PetscFunctionBegin;
ierr = VecCreate(PetscObjectComm((PetscObject)win),v);CHKERRQ(ierr);
ierr = PetscLayoutReference(win->map,&(*v)->map);CHKERRQ(ierr);
ierr = VecCreate_MPI_Private(*v,PETSC_TRUE,w->nghost,0);CHKERRQ(ierr);
vw = (Vec_MPI*)(*v)->data;
ierr = PetscMemcpy((*v)->ops,win->ops,sizeof(struct _VecOps));CHKERRQ(ierr);
/* save local representation of the parallel vector (and scatter) if it exists */
if (w->localrep) {
ierr = VecGetArray(*v,&array);CHKERRQ(ierr);
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,PetscAbs(win->map->bs),win->map->n+w->nghost,array,&vw->localrep);CHKERRQ(ierr);
ierr = PetscMemcpy(vw->localrep->ops,w->localrep->ops,sizeof(struct _VecOps));CHKERRQ(ierr);
ierr = VecRestoreArray(*v,&array);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)*v,(PetscObject)vw->localrep);CHKERRQ(ierr);
vw->localupdate = w->localupdate;
if (vw->localupdate) {
ierr = PetscObjectReference((PetscObject)vw->localupdate);CHKERRQ(ierr);
}
}
/* New vector should inherit stashing property of parent */
(*v)->stash.donotstash = win->stash.donotstash;
(*v)->stash.ignorenegidx = win->stash.ignorenegidx;
ierr = PetscObjectListDuplicate(((PetscObject)win)->olist,&((PetscObject)(*v))->olist);CHKERRQ(ierr);
ierr = PetscFunctionListDuplicate(((PetscObject)win)->qlist,&((PetscObject)(*v))->qlist);CHKERRQ(ierr);
(*v)->map->bs = PetscAbs(win->map->bs);
(*v)->bstash.bs = win->bstash.bs;
PetscFunctionReturn(0);
}
END_TEST
START_TEST( test_LeastSq )
{
PetscErrorCode ierr;
PetscReal x[7] = {-2.50725, -1.7072, -0.726423, 0.452286, 1.81034, 2.53149, 3.76245},
y[7] = {1, 2, 5, 9, 7, 6, 5},
sol[3] = {6.715669164916147,1.2967934985903051,-0.9888109988616558};
int np = 7;
PetscReal *s, *g;
LeastSq ls;
ierr = LeastSqCreate( 17, &ls); CHKERRQ(ierr);
ierr = LeastSqSetNumPoints(ls, 7); CHKERRQ(ierr);
ierr = LeastSqGetVecs(ls, &s, &g, PETSC_NULL); CHKERRQ(ierr);
for (int i = 0; i < np; ++i) {
s[i] = x[i];
g[i] = y[i];
}
ierr = LeastSqSolve( ls ); CHKERRQ(ierr);
for (int i = 0; i < 3; ++i) {
fail_unless(PetscAbs(g[i]-sol[i])<.0001, "g: %f\t s:%f\t\n", g[i], sol[i] );
}
PetscReal xx[4] = {1, 4, 8, 10},
yy[4] = {1, 5, 3, 6},
ssol[3]= {0.7202797202797178, 0.8846153846153864, -0.09090909090909123};
ierr = LeastSqSetNumPoints(ls, 4); CHKERRQ(ierr);
for (int i = 0; i < np; ++i) {
s[i] = xx[i];
g[i] = yy[i];
}
ierr = LeastSqSolve( ls ); CHKERRQ(ierr);
for (int i = 0; i < 3; ++i)
fail_unless(PetscAbs(g[i]-ssol[i])<.0001, "%d\t g: %f\t s:%f\t\n", i, g[i], ssol[i] );
ierr = LeastSqDestroy(ls); CHKERRQ(ierr);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscInt i,j,degrees[1000],ndegrees,nsrc_points,ntarget_points;
PetscReal src_points[1000],target_points[1000],*R;
PetscBool flg;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Discretization tools test options",NULL);CHKERRQ(ierr);
{
ndegrees = 1000;
degrees[0] = 1;
degrees[1] = 2;
degrees[2] = 3;
ierr = PetscOptionsIntArray("-degrees","list of max degrees to evaluate","",degrees,&ndegrees,&flg);CHKERRQ(ierr);
if (!flg) ndegrees = 3;
nsrc_points = 1000;
src_points[0] = -1.;
src_points[1] = 0.;
src_points[2] = 1.;
ierr = PetscOptionsRealArray("-src_points","list of points defining intervals on which to integrate","",src_points,&nsrc_points,&flg);CHKERRQ(ierr);
if (!flg) nsrc_points = 3;
ntarget_points = 1000;
target_points[0] = -1.;
target_points[1] = 0.;
target_points[2] = 1.;
ierr = PetscOptionsRealArray("-target_points","list of points defining intervals on which to integrate","",target_points,&ntarget_points,&flg);CHKERRQ(ierr);
if (!flg) ntarget_points = 3;
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = PetscMalloc1((nsrc_points-1)*(ntarget_points-1),&R);CHKERRQ(ierr);
for (i=0; i<ndegrees; i++) {
ierr = PetscDTReconstructPoly(degrees[i],nsrc_points-1,src_points,ntarget_points-1,target_points,R);CHKERRQ(ierr);
for (j=0; j<(ntarget_points-1)*(nsrc_points-1); j++) { /* Truncate to zero for nicer output */
if (PetscAbs(R[j]) < 10*PETSC_MACHINE_EPSILON) R[j] = 0;
}
for (j=0; j<ntarget_points-1; j++) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Degree %D target interval (%g,%g)\n",degrees[i],(double)target_points[j],(double)target_points[j+1]);CHKERRQ(ierr);
ierr = PetscRealView(nsrc_points-1,R+j*(nsrc_points-1),PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
}
ierr = PetscFree(R);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode UMStats(UM *mesh, double *maxh, double *meanh, double *maxa, double *meana) {
PetscErrorCode ierr;
const int *ae;
const Node *aloc;
int k;
double x[3], y[3], ax, ay, bx, by, cx, cy, h, a,
Maxh = 0.0, Maxa = 0.0, Sumh = 0.0, Suma = 0.0;
if ((mesh->K == 0) || (mesh->e == NULL)) {
SETERRQ(PETSC_COMM_WORLD,1,
"number of elements unknown; call UMReadElements() first\n");
}
if (mesh->N == 0) {
SETERRQ(PETSC_COMM_WORLD,2,
"node size unknown so element check impossible; call UMReadNodes() first\n");
}
ierr = UMGetNodeCoordArrayRead(mesh,&aloc); CHKERRQ(ierr);
ierr = ISGetIndices(mesh->e,&ae); CHKERRQ(ierr);
for (k = 0; k < mesh->K; k++) {
x[0] = aloc[ae[3*k]].x;
y[0] = aloc[ae[3*k]].y;
x[1] = aloc[ae[3*k+1]].x;
y[1] = aloc[ae[3*k+1]].y;
x[2] = aloc[ae[3*k+2]].x;
y[2] = aloc[ae[3*k+2]].y;
ax = x[1] - x[0];
ay = y[1] - y[0];
bx = x[2] - x[0];
by = y[2] - y[0];
cx = x[1] - x[2];
cy = y[1] - y[2];
h = PetscMax(ax*ax+ay*ay, PetscMax(bx*bx+by*by, cx*cx+cy*cy));
h = sqrt(h);
a = 0.5 * PetscAbs(ax*by-ay*bx);
Maxh = PetscMax(Maxh,h);
Sumh += h;
Maxa = PetscMax(Maxa,a);
Suma += a;
}
ierr = ISRestoreIndices(mesh->e,&ae); CHKERRQ(ierr);
ierr = UMRestoreNodeCoordArrayRead(mesh,&aloc); CHKERRQ(ierr);
if (maxh) *maxh = Maxh;
if (maxa) *maxa = Maxa;
if (meanh) *meanh = Sumh / mesh->K;
if (meana) *meana = Suma / mesh->K;
return 0;
}
/*
VecCreate_MPI_Private - Basic create routine called by VecCreate_MPI() (i.e. VecCreateMPI()),
VecCreateMPIWithArray(), VecCreate_Shared() (i.e. VecCreateShared()), VecCreateGhost(),
VecDuplicate_MPI(), VecCreateGhostWithArray(), VecDuplicate_MPI(), and VecDuplicate_Shared()
If alloc is true and array is NULL then this routine allocates the space, otherwise
no space is allocated.
*/
PetscErrorCode VecCreate_MPI_Private(Vec v,PetscBool alloc,PetscInt nghost,const PetscScalar array[])
{
Vec_MPI *s;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscNewLog(v,&s);CHKERRQ(ierr);
v->data = (void*)s;
ierr = PetscMemcpy(v->ops,&DvOps,sizeof(DvOps));CHKERRQ(ierr);
s->nghost = nghost;
v->petscnative = PETSC_TRUE;
ierr = PetscLayoutSetUp(v->map);CHKERRQ(ierr);
s->array = (PetscScalar*)array;
s->array_allocated = 0;
if (alloc && !array) {
PetscInt n = v->map->n+nghost;
ierr = PetscMalloc1(n,&s->array);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)v,n*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(s->array,n*sizeof(PetscScalar));CHKERRQ(ierr);
s->array_allocated = s->array;
}
/* By default parallel vectors do not have local representation */
s->localrep = 0;
s->localupdate = 0;
v->stash.insertmode = NOT_SET_VALUES;
v->bstash.insertmode = NOT_SET_VALUES;
/* create the stashes. The block-size for bstash is set later when
VecSetValuesBlocked is called.
*/
ierr = VecStashCreate_Private(PetscObjectComm((PetscObject)v),1,&v->stash);CHKERRQ(ierr);
ierr = VecStashCreate_Private(PetscObjectComm((PetscObject)v),PetscAbs(v->map->bs),&v->bstash);CHKERRQ(ierr);
#if defined(PETSC_HAVE_MATLAB_ENGINE)
ierr = PetscObjectComposeFunction((PetscObject)v,"PetscMatlabEnginePut_C",VecMatlabEnginePut_Default);CHKERRQ(ierr);
ierr = PetscObjectComposeFunction((PetscObject)v,"PetscMatlabEngineGet_C",VecMatlabEngineGet_Default);CHKERRQ(ierr);
#endif
ierr = PetscObjectChangeTypeName((PetscObject)v,VECMPI);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PetscDrawArrow_X(PetscDraw draw,PetscReal xl,PetscReal yl,PetscReal xr,PetscReal yr,int cl)
{
PetscDraw_X* XiWin = (PetscDraw_X*)draw->data;
int x1,y_1,x2,y2;
PetscFunctionBegin;
PetscDrawXiSetColor(XiWin,cl);
x1 = XTRANS(draw,XiWin,xl); x2 = XTRANS(draw,XiWin,xr);
y_1 = YTRANS(draw,XiWin,yl); y2 = YTRANS(draw,XiWin,yr);
if (x1 == x2 && y_1 == y2) PetscFunctionReturn(0);
XDrawLine(XiWin->disp,PetscDrawXiDrawable(XiWin),XiWin->gc.set,x1,y_1,x2,y2);
if (x1 == x2 && PetscAbs(y_1 - y2) > 7) {
if (y2 > y_1) {
XDrawLine(XiWin->disp,PetscDrawXiDrawable(XiWin),XiWin->gc.set,x2,y2,x2-3,y2-3);
XDrawLine(XiWin->disp,PetscDrawXiDrawable(XiWin),XiWin->gc.set,x2,y2,x2+3,y2-3);
} else {
XDrawLine(XiWin->disp,PetscDrawXiDrawable(XiWin),XiWin->gc.set,x2,y2,x2-3,y2+3);
XDrawLine(XiWin->disp,PetscDrawXiDrawable(XiWin),XiWin->gc.set,x2,y2,x2+3,y2+3);
}
}
PetscFunctionReturn(0);
}
PetscErrorCode MatPtAPSymbolic_SeqAIJ_SeqAIJ_SparseAxpy(Mat A,Mat P,PetscReal fill,Mat *C)
{
PetscErrorCode ierr;
PetscFreeSpaceList free_space=NULL,current_space=NULL;
Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data,*p = (Mat_SeqAIJ*)P->data,*c;
PetscInt *pti,*ptj,*ptJ,*ai=a->i,*aj=a->j,*ajj,*pi=p->i,*pj=p->j,*pjj;
PetscInt *ci,*cj,*ptadenserow,*ptasparserow,*ptaj,nspacedouble=0;
PetscInt an=A->cmap->N,am=A->rmap->N,pn=P->cmap->N,pm=P->rmap->N;
PetscInt i,j,k,ptnzi,arow,anzj,ptanzi,prow,pnzj,cnzi,nlnk,*lnk;
MatScalar *ca;
PetscBT lnkbt;
PetscReal afill;
PetscFunctionBegin;
/* Get ij structure of P^T */
ierr = MatGetSymbolicTranspose_SeqAIJ(P,&pti,&ptj);CHKERRQ(ierr);
ptJ = ptj;
/* Allocate ci array, arrays for fill computation and */
/* free space for accumulating nonzero column info */
ierr = PetscMalloc1(pn+1,&ci);CHKERRQ(ierr);
ci[0] = 0;
ierr = PetscCalloc1(2*an+1,&ptadenserow);CHKERRQ(ierr);
ptasparserow = ptadenserow + an;
/* create and initialize a linked list */
nlnk = pn+1;
ierr = PetscLLCreate(pn,pn,nlnk,lnk,lnkbt);CHKERRQ(ierr);
/* Set initial free space to be fill*(nnz(A)+ nnz(P)) */
ierr = PetscFreeSpaceGet(PetscRealIntMultTruncate(fill,PetscIntSumTruncate(ai[am],pi[pm])),&free_space);CHKERRQ(ierr);
current_space = free_space;
/* Determine symbolic info for each row of C: */
for (i=0; i<pn; i++) {
ptnzi = pti[i+1] - pti[i];
ptanzi = 0;
/* Determine symbolic row of PtA: */
for (j=0; j<ptnzi; j++) {
arow = *ptJ++;
anzj = ai[arow+1] - ai[arow];
ajj = aj + ai[arow];
for (k=0; k<anzj; k++) {
if (!ptadenserow[ajj[k]]) {
ptadenserow[ajj[k]] = -1;
ptasparserow[ptanzi++] = ajj[k];
}
}
}
/* Using symbolic info for row of PtA, determine symbolic info for row of C: */
ptaj = ptasparserow;
cnzi = 0;
for (j=0; j<ptanzi; j++) {
prow = *ptaj++;
pnzj = pi[prow+1] - pi[prow];
pjj = pj + pi[prow];
/* add non-zero cols of P into the sorted linked list lnk */
ierr = PetscLLAddSorted(pnzj,pjj,pn,nlnk,lnk,lnkbt);CHKERRQ(ierr);
cnzi += nlnk;
}
/* If free space is not available, make more free space */
/* Double the amount of total space in the list */
if (current_space->local_remaining<cnzi) {
ierr = PetscFreeSpaceGet(PetscIntSumTruncate(cnzi,current_space->total_array_size),¤t_space);CHKERRQ(ierr);
nspacedouble++;
}
/* Copy data into free space, and zero out denserows */
ierr = PetscLLClean(pn,pn,cnzi,lnk,current_space->array,lnkbt);CHKERRQ(ierr);
current_space->array += cnzi;
current_space->local_used += cnzi;
current_space->local_remaining -= cnzi;
for (j=0; j<ptanzi; j++) ptadenserow[ptasparserow[j]] = 0;
/* Aside: Perhaps we should save the pta info for the numerical factorization. */
/* For now, we will recompute what is needed. */
ci[i+1] = ci[i] + cnzi;
}
/* nnz is now stored in ci[ptm], column indices are in the list of free space */
/* Allocate space for cj, initialize cj, and */
/* destroy list of free space and other temporary array(s) */
ierr = PetscMalloc1(ci[pn]+1,&cj);CHKERRQ(ierr);
ierr = PetscFreeSpaceContiguous(&free_space,cj);CHKERRQ(ierr);
ierr = PetscFree(ptadenserow);CHKERRQ(ierr);
ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
ierr = PetscCalloc1(ci[pn]+1,&ca);CHKERRQ(ierr);
/* put together the new matrix */
ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),pn,pn,ci,cj,ca,C);CHKERRQ(ierr);
ierr = MatSetBlockSizes(*C,PetscAbs(P->cmap->bs),PetscAbs(P->cmap->bs));CHKERRQ(ierr);
/* MatCreateSeqAIJWithArrays flags matrix so PETSc doesn't free the user's arrays. */
/* Since these are PETSc arrays, change flags to free them as necessary. */
c = (Mat_SeqAIJ*)((*C)->data);
c->free_a = PETSC_TRUE;
c->free_ij = PETSC_TRUE;
c->nonew = 0;
(*C)->ops->ptapnumeric = MatPtAPNumeric_SeqAIJ_SeqAIJ_SparseAxpy;
/* set MatInfo */
afill = (PetscReal)ci[pn]/(ai[am]+pi[pm] + 1.e-5);
if (afill < 1.0) afill = 1.0;
c->maxnz = ci[pn];
c->nz = ci[pn];
(*C)->info.mallocs = nspacedouble;
(*C)->info.fill_ratio_given = fill;
(*C)->info.fill_ratio_needed = afill;
/* Clean up. */
ierr = MatRestoreSymbolicTranspose_SeqAIJ(P,&pti,&ptj);CHKERRQ(ierr);
#if defined(PETSC_USE_INFO)
if (ci[pn] != 0) {
ierr = PetscInfo3((*C),"Reallocs %D; Fill ratio: given %g needed %g.\n",nspacedouble,(double)fill,(double)afill);CHKERRQ(ierr);
ierr = PetscInfo1((*C),"Use MatPtAP(A,P,MatReuse,%g,&C) for best performance.\n",(double)afill);CHKERRQ(ierr);
} else {
ierr = PetscInfo((*C),"Empty matrix product\n");CHKERRQ(ierr);
}
#endif
PetscFunctionReturn(0);
}
PetscErrorCode SetInitialGuess(Vec X,AppCtx *user)
{
PetscErrorCode ierr;
PetscInt n,i,Mda;
PetscScalar *xx,*cv_p,*wv_p,*eta_p;
PetscViewer view_out;
/* needed for the void growth case */
PetscScalar xmid,cv_v=1.0,cv_m=user->Sv*user->cv0,eta_v=1.0,eta_m=0.0,h,lambda;
PetscInt nele,nen,idx[2];
const PetscInt *ele;
PetscScalar x[2];
Vec coords;
const PetscScalar *_coords;
PetscScalar xwidth = user->xmax - user->xmin;
PetscFunctionBeginUser;
ierr = VecGetLocalSize(X,&n);CHKERRQ(ierr);
ierr = DMDAGetInfo(user->da2,NULL,&Mda,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(user->da2,&coords);CHKERRQ(ierr);
ierr = VecGetArrayRead(coords,&_coords);CHKERRQ(ierr);
if (user->periodic) h = (user->xmax-user->xmin)/Mda;
else h = (user->xmax-user->xmin)/(Mda-1.0);
xmid = (user->xmax + user->xmin)/2.0;
lambda = 4.0*h;
ierr = DMDAGetElements(user->da2,&nele,&nen,&ele);CHKERRQ(ierr);
for (i=0; i < nele; i++) {
idx[0] = ele[2*i]; idx[1] = ele[2*i+1];
x[0] = _coords[idx[0]];
x[1] = _coords[idx[1]];
PetscInt k;
PetscScalar vals_DDcv[2],vals_cv[2],vals_eta[2],s,hhr,r;
for (k=0; k < 2; k++) {
s = PetscAbs(x[k] - xmid);
if (s <= xwidth*(5.0/64.0)) {
vals_cv[k] = cv_v;
vals_eta[k] = eta_v;
vals_DDcv[k] = 0.0;
} else if (s> xwidth*(5.0/64.0) && s<= xwidth*(7.0/64.0)) {
/*r = (s - xwidth*(6.0/64.0))/(0.5*lambda);*/
r = (s - xwidth*(6.0/64.0))/(xwidth/64.0);
hhr = 0.25*(-r*r*r + 3*r + 2);
vals_cv[k] = cv_m + (1.0 - hhr)*(cv_v - cv_m);
vals_eta[k] = eta_m + (1.0 - hhr)*(eta_v - eta_m);
vals_DDcv[k] = (cv_v - cv_m)*r*6.0/(lambda*lambda);
} else {
vals_cv[k] = cv_m;
vals_eta[k] = eta_m;
vals_DDcv[k] = 0.0;
}
}
ierr = VecSetValuesLocal(user->cv,2,idx,vals_cv,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecSetValuesLocal(user->eta,2,idx,vals_eta,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecSetValuesLocal(user->work2,2,idx,vals_DDcv,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = DMDARestoreElements(user->da2,&nele,&nen,&ele);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(coords,&_coords);CHKERRQ(ierr);
ierr = VecAssemblyBegin(user->cv);CHKERRQ(ierr);
ierr = VecAssemblyEnd(user->cv);CHKERRQ(ierr);
ierr = VecAssemblyBegin(user->eta);CHKERRQ(ierr);
ierr = VecAssemblyEnd(user->eta);CHKERRQ(ierr);
ierr = VecAssemblyBegin(user->work2);CHKERRQ(ierr);
ierr = VecAssemblyEnd(user->work2);CHKERRQ(ierr);
ierr = DPsi(user);CHKERRQ(ierr);
ierr = VecCopy(user->DPsiv,user->wv);CHKERRQ(ierr);
ierr = VecAXPY(user->wv,-2.0*user->kav,user->work2);CHKERRQ(ierr);
ierr = VecGetArray(X,&xx);CHKERRQ(ierr);
ierr = VecGetArray(user->wv,&wv_p);CHKERRQ(ierr);
ierr = VecGetArray(user->cv,&cv_p);CHKERRQ(ierr);
ierr = VecGetArray(user->eta,&eta_p);CHKERRQ(ierr);
for (i=0; i<n/3; i++) {
xx[3*i] =wv_p[i];
xx[3*i+1]=cv_p[i];
xx[3*i+2]=eta_p[i];
}
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"file_initial",FILE_MODE_WRITE,&view_out);CHKERRQ(ierr);
ierr = VecView(user->wv,view_out);CHKERRQ(ierr);
ierr = VecView(user->cv,view_out);CHKERRQ(ierr);
ierr = VecView(user->eta,view_out);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&view_out);CHKERRQ(ierr);
ierr = VecRestoreArray(X,&xx);CHKERRQ(ierr);
ierr = VecRestoreArray(user->wv,&wv_p);CHKERRQ(ierr);
ierr = VecRestoreArray(user->cv,&cv_p);CHKERRQ(ierr);
ierr = VecRestoreArray(user->eta,&eta_p);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
DS ds;
FN f1,f2,f3,funs[3];
PetscScalar *Id,*A,*B,*wr,*wi,coeffs[2];
PetscReal tau=0.001,h,a=20,xi,re,im;
PetscInt i,n=10,ld,nev;
PetscViewer viewer;
PetscBool verbose;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-tau",&tau,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Solve a Dense System of type NEP - dimension %D, tau=%g.\n",n,(double)tau);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-verbose",&verbose);CHKERRQ(ierr);
/* Create DS object */
ierr = DSCreate(PETSC_COMM_WORLD,&ds);CHKERRQ(ierr);
ierr = DSSetType(ds,DSNEP);CHKERRQ(ierr);
ierr = DSSetFromOptions(ds);CHKERRQ(ierr);
/* Set functions (prior to DSAllocate) */
ierr = FNCreate(PETSC_COMM_WORLD,&f1);CHKERRQ(ierr);
ierr = FNSetType(f1,FNRATIONAL);CHKERRQ(ierr);
coeffs[0] = -1.0; coeffs[1] = 0.0;
ierr = FNSetParameters(f1,2,coeffs,0,NULL);CHKERRQ(ierr);
ierr = FNCreate(PETSC_COMM_WORLD,&f2);CHKERRQ(ierr);
ierr = FNSetType(f2,FNRATIONAL);CHKERRQ(ierr);
coeffs[0] = 1.0;
ierr = FNSetParameters(f2,1,coeffs,0,NULL);CHKERRQ(ierr);
ierr = FNCreate(PETSC_COMM_WORLD,&f3);CHKERRQ(ierr);
ierr = FNSetType(f3,FNEXP);CHKERRQ(ierr);
coeffs[0] = -tau;
ierr = FNSetParameters(f3,1,coeffs,0,NULL);CHKERRQ(ierr);
funs[0] = f1;
funs[1] = f2;
funs[2] = f3;
ierr = DSSetFN(ds,3,funs);CHKERRQ(ierr);
/* Set dimensions */
ld = n+2; /* test leading dimension larger than n */
ierr = DSAllocate(ds,ld);CHKERRQ(ierr);
ierr = DSSetDimensions(ds,n,0,0,0);CHKERRQ(ierr);
/* Set up viewer */
ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_INFO_DETAIL);CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
if (verbose) {
ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
}
/* Fill matrices */
ierr = DSGetArray(ds,DS_MAT_E0,&Id);CHKERRQ(ierr);
for (i=0;i<n;i++) Id[i+i*ld]=1.0;
ierr = DSRestoreArray(ds,DS_MAT_E0,&Id);CHKERRQ(ierr);
h = PETSC_PI/(PetscReal)(n+1);
ierr = DSGetArray(ds,DS_MAT_E1,&A);CHKERRQ(ierr);
for (i=0;i<n;i++) A[i+i*ld]=-2.0/(h*h)+a;
for (i=1;i<n;i++) {
A[i+(i-1)*ld]=1.0/(h*h);
A[(i-1)+i*ld]=1.0/(h*h);
}
ierr = DSRestoreArray(ds,DS_MAT_E1,&A);CHKERRQ(ierr);
ierr = DSGetArray(ds,DS_MAT_E2,&B);CHKERRQ(ierr);
for (i=0;i<n;i++) {
xi = (i+1)*h;
B[i+i*ld] = -4.1+xi*(1.0-PetscExpReal(xi-PETSC_PI));
}
ierr = DSRestoreArray(ds,DS_MAT_E2,&B);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Initial - - - - - - - - -\n");CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
}
/* Solve */
ierr = PetscMalloc2(n,&wr,n,&wi);CHKERRQ(ierr);
ierr = DSSolve(ds,wr,wi);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"After solve - - - - - - - - -\n");CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
}
/* Print first eigenvalue */
ierr = PetscPrintf(PETSC_COMM_WORLD,"Computed eigenvalue =\n",n);CHKERRQ(ierr);
nev = 1;
for (i=0;i<nev;i++) {
#if defined(PETSC_USE_COMPLEX)
re = PetscRealPart(wr[i]);
im = PetscImaginaryPart(wr[i]);
#else
re = wr[i];
im = wi[i];
#endif
if (PetscAbs(im)<1e-10) {
ierr = PetscViewerASCIIPrintf(viewer," %.5f\n",(double)re);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer," %.5f%+.5fi\n",(double)re,(double)im);CHKERRQ(ierr);
}
}
ierr = PetscFree2(wr,wi);CHKERRQ(ierr);
ierr = FNDestroy(&f1);CHKERRQ(ierr);
ierr = FNDestroy(&f2);CHKERRQ(ierr);
ierr = FNDestroy(&f3);CHKERRQ(ierr);
ierr = DSDestroy(&ds);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
DS ds;
SlepcSC sc;
PetscScalar *A,*B,*wr,*wi;
PetscReal re,im;
PetscInt i,j,n=10,ld;
PetscViewer viewer;
PetscBool verbose;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Solve a Dense System of type GNHEP - dimension %D.\n",n);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-verbose",&verbose);CHKERRQ(ierr);
/* Create DS object */
ierr = DSCreate(PETSC_COMM_WORLD,&ds);CHKERRQ(ierr);
ierr = DSSetType(ds,DSGNHEP);CHKERRQ(ierr);
ierr = DSSetFromOptions(ds);CHKERRQ(ierr);
ld = n+2; /* test leading dimension larger than n */
ierr = DSAllocate(ds,ld);CHKERRQ(ierr);
ierr = DSSetDimensions(ds,n,0,0,0);CHKERRQ(ierr);
/* Set up viewer */
ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_INFO_DETAIL);CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
if (verbose) {
ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
}
/* Fill A with Grcar matrix */
ierr = DSGetArray(ds,DS_MAT_A,&A);CHKERRQ(ierr);
ierr = PetscMemzero(A,sizeof(PetscScalar)*ld*n);CHKERRQ(ierr);
for (i=1;i<n;i++) A[i+(i-1)*ld]=-1.0;
for (j=0;j<4;j++) {
for (i=0;i<n-j;i++) A[i+(i+j)*ld]=1.0;
}
ierr = DSRestoreArray(ds,DS_MAT_A,&A);CHKERRQ(ierr);
/* Fill B with an identity matrix */
ierr = DSGetArray(ds,DS_MAT_B,&B);CHKERRQ(ierr);
ierr = PetscMemzero(B,sizeof(PetscScalar)*ld*n);CHKERRQ(ierr);
for (i=0;i<n;i++) B[i+i*ld]=1.0;
ierr = DSRestoreArray(ds,DS_MAT_B,&B);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Initial - - - - - - - - -\n");CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
}
/* Solve */
ierr = PetscMalloc2(n,&wr,n,&wi);CHKERRQ(ierr);
ierr = DSGetSlepcSC(ds,&sc);CHKERRQ(ierr);
sc->comparison = SlepcCompareLargestMagnitude;
sc->comparisonctx = NULL;
sc->map = NULL;
sc->mapobj = NULL;
ierr = DSSolve(ds,wr,wi);CHKERRQ(ierr);
ierr = DSSort(ds,wr,wi,NULL,NULL,NULL);CHKERRQ(ierr);
if (verbose) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"After solve - - - - - - - - -\n");CHKERRQ(ierr);
ierr = DSView(ds,viewer);CHKERRQ(ierr);
}
/* Print eigenvalues */
ierr = PetscPrintf(PETSC_COMM_WORLD,"Computed eigenvalues =\n",n);CHKERRQ(ierr);
for (i=0;i<n;i++) {
#if defined(PETSC_USE_COMPLEX)
re = PetscRealPart(wr[i]);
im = PetscImaginaryPart(wr[i]);
#else
re = wr[i];
im = wi[i];
#endif
if (PetscAbs(im)<1e-10) {
ierr = PetscViewerASCIIPrintf(viewer," %.5f\n",(double)re);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer," %.5f%+.5fi\n",(double)re,(double)im);CHKERRQ(ierr);
}
}
ierr = PetscFree2(wr,wi);CHKERRQ(ierr);
ierr = DSDestroy(&ds);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
/*@C
PCGAMGFilterGraph - filter (remove zero and possibly small values from the) graph and make it symmetric if requested
Collective on Mat
Input Parameter:
+ a_Gmat - the graph
. vfilter - threshold paramter [0,1)
- symm - make the result symmetric
Level: developer
Notes:
This is called before graph coarsers are called.
.seealso: PCGAMGSetThreshold()
@*/
PetscErrorCode PCGAMGFilterGraph(Mat *a_Gmat,PetscReal vfilter,PetscBool symm)
{
PetscErrorCode ierr;
PetscInt Istart,Iend,Ii,jj,ncols,nnz0,nnz1, NN, MM, nloc;
PetscMPIInt rank;
Mat Gmat = *a_Gmat, tGmat, matTrans;
MPI_Comm comm;
const PetscScalar *vals;
const PetscInt *idx;
PetscInt *d_nnz, *o_nnz;
Vec diag;
MatType mtype;
PetscFunctionBegin;
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
/* scale Gmat for all values between -1 and 1 */
ierr = MatCreateVecs(Gmat, &diag, 0);CHKERRQ(ierr);
ierr = MatGetDiagonal(Gmat, diag);CHKERRQ(ierr);
ierr = VecReciprocal(diag);CHKERRQ(ierr);
ierr = VecSqrtAbs(diag);CHKERRQ(ierr);
ierr = MatDiagonalScale(Gmat, diag, diag);CHKERRQ(ierr);
ierr = VecDestroy(&diag);CHKERRQ(ierr);
if (vfilter < 0.0 && !symm) {
/* Just use the provided matrix as the graph but make all values positive */
MatInfo info;
PetscScalar *avals;
PetscBool isaij,ismpiaij;
ierr = PetscObjectBaseTypeCompare((PetscObject)Gmat,MATSEQAIJ,&isaij);CHKERRQ(ierr);
ierr = PetscObjectBaseTypeCompare((PetscObject)Gmat,MATMPIAIJ,&ismpiaij);CHKERRQ(ierr);
if (!isaij && !ismpiaij) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"Require (MPI)AIJ matrix type");
if (isaij) {
ierr = MatGetInfo(Gmat,MAT_LOCAL,&info);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(Gmat,&avals);CHKERRQ(ierr);
for (jj = 0; jj<info.nz_used; jj++) avals[jj] = PetscAbsScalar(avals[jj]);
ierr = MatSeqAIJRestoreArray(Gmat,&avals);CHKERRQ(ierr);
} else {
Mat_MPIAIJ *aij = (Mat_MPIAIJ*)Gmat->data;
ierr = MatGetInfo(aij->A,MAT_LOCAL,&info);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(aij->A,&avals);CHKERRQ(ierr);
for (jj = 0; jj<info.nz_used; jj++) avals[jj] = PetscAbsScalar(avals[jj]);
ierr = MatSeqAIJRestoreArray(aij->A,&avals);CHKERRQ(ierr);
ierr = MatGetInfo(aij->B,MAT_LOCAL,&info);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(aij->B,&avals);CHKERRQ(ierr);
for (jj = 0; jj<info.nz_used; jj++) avals[jj] = PetscAbsScalar(avals[jj]);
ierr = MatSeqAIJRestoreArray(aij->B,&avals);CHKERRQ(ierr);
}
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
PetscFunctionReturn(0);
}
ierr = PetscObjectGetComm((PetscObject)Gmat,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(Gmat, &Istart, &Iend);CHKERRQ(ierr);
nloc = Iend - Istart;
ierr = MatGetSize(Gmat, &MM, &NN);CHKERRQ(ierr);
if (symm) {
ierr = MatTranspose(Gmat, MAT_INITIAL_MATRIX, &matTrans);CHKERRQ(ierr);
}
/* Determine upper bound on nonzeros needed in new filtered matrix */
ierr = PetscMalloc2(nloc, &d_nnz,nloc, &o_nnz);CHKERRQ(ierr);
for (Ii = Istart, jj = 0; Ii < Iend; Ii++, jj++) {
ierr = MatGetRow(Gmat,Ii,&ncols,NULL,NULL);CHKERRQ(ierr);
d_nnz[jj] = ncols;
o_nnz[jj] = ncols;
ierr = MatRestoreRow(Gmat,Ii,&ncols,NULL,NULL);CHKERRQ(ierr);
if (symm) {
ierr = MatGetRow(matTrans,Ii,&ncols,NULL,NULL);CHKERRQ(ierr);
d_nnz[jj] += ncols;
o_nnz[jj] += ncols;
ierr = MatRestoreRow(matTrans,Ii,&ncols,NULL,NULL);CHKERRQ(ierr);
}
if (d_nnz[jj] > nloc) d_nnz[jj] = nloc;
if (o_nnz[jj] > (MM-nloc)) o_nnz[jj] = MM - nloc;
}
ierr = MatGetType(Gmat,&mtype);CHKERRQ(ierr);
ierr = MatCreate(comm, &tGmat);CHKERRQ(ierr);
ierr = MatSetSizes(tGmat,nloc,nloc,MM,MM);CHKERRQ(ierr);
ierr = MatSetBlockSizes(tGmat, 1, 1);CHKERRQ(ierr);
ierr = MatSetType(tGmat, mtype);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(tGmat,0,d_nnz);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(tGmat,0,d_nnz,0,o_nnz);CHKERRQ(ierr);
ierr = PetscFree2(d_nnz,o_nnz);CHKERRQ(ierr);
if (symm) {
ierr = MatDestroy(&matTrans);CHKERRQ(ierr);
} else {
/* all entries are generated locally so MatAssembly will be slightly faster for large process counts */
ierr = MatSetOption(tGmat,MAT_NO_OFF_PROC_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
}
for (Ii = Istart, nnz0 = nnz1 = 0; Ii < Iend; Ii++) {
ierr = MatGetRow(Gmat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
for (jj=0; jj<ncols; jj++,nnz0++) {
PetscScalar sv = PetscAbs(PetscRealPart(vals[jj]));
if (PetscRealPart(sv) > vfilter) {
nnz1++;
if (symm) {
sv *= 0.5;
ierr = MatSetValues(tGmat,1,&Ii,1,&idx[jj],&sv,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(tGmat,1,&idx[jj],1,&Ii,&sv,ADD_VALUES);CHKERRQ(ierr);
} else {
ierr = MatSetValues(tGmat,1,&Ii,1,&idx[jj],&sv,ADD_VALUES);CHKERRQ(ierr);
}
}
}
ierr = MatRestoreRow(Gmat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(tGmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(tGmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
#if defined(PETSC_USE_INFO)
{
double t1 = (!nnz0) ? 1. : 100.*(double)nnz1/(double)nnz0, t2 = (!nloc) ? 1. : (double)nnz0/(double)nloc;
ierr = PetscInfo4(*a_Gmat,"\t %g%% nnz after filtering, with threshold %g, %g nnz ave. (N=%D)\n",t1,vfilter,t2,MM);CHKERRQ(ierr);
}
#endif
ierr = MatDestroy(&Gmat);CHKERRQ(ierr);
*a_Gmat = tGmat;
PetscFunctionReturn(0);
}
/*
PCGAMGCreateGraph - create simple scaled scalar graph from matrix
Input Parameter:
. Amat - matrix
Output Parameter:
. a_Gmaat - eoutput scalar graph (symmetric?)
*/
PetscErrorCode PCGAMGCreateGraph(Mat Amat, Mat *a_Gmat)
{
PetscErrorCode ierr;
PetscInt Istart,Iend,Ii,jj,kk,ncols,nloc,NN,MM,bs;
MPI_Comm comm;
Mat Gmat;
MatType mtype;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)Amat,&comm);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(Amat, &Istart, &Iend);CHKERRQ(ierr);
ierr = MatGetSize(Amat, &MM, &NN);CHKERRQ(ierr);
ierr = MatGetBlockSize(Amat, &bs);CHKERRQ(ierr);
nloc = (Iend-Istart)/bs;
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
if (bs > 1) {
const PetscScalar *vals;
const PetscInt *idx;
PetscInt *d_nnz, *o_nnz,*w0,*w1,*w2;
PetscBool ismpiaij,isseqaij;
/*
Determine the preallocation needed for the scalar matrix derived from the vector matrix.
*/
ierr = PetscObjectBaseTypeCompare((PetscObject)Amat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
ierr = PetscObjectBaseTypeCompare((PetscObject)Amat,MATMPIAIJ,&ismpiaij);CHKERRQ(ierr);
ierr = PetscMalloc2(nloc, &d_nnz,isseqaij ? 0 : nloc, &o_nnz);CHKERRQ(ierr);
if (isseqaij) {
PetscInt max_d_nnz;
/*
Determine exact preallocation count for (sequential) scalar matrix
*/
ierr = MatSeqAIJGetMaxRowNonzeros(Amat,&max_d_nnz);CHKERRQ(ierr);
max_d_nnz = PetscMin(nloc,bs*max_d_nnz);CHKERRQ(ierr);
ierr = PetscMalloc3(max_d_nnz, &w0,max_d_nnz, &w1,max_d_nnz, &w2);CHKERRQ(ierr);
for (Ii = 0, jj = 0; Ii < Iend; Ii += bs, jj++) {
ierr = MatCollapseRows(Amat,Ii,bs,w0,w1,w2,&d_nnz[jj],NULL);CHKERRQ(ierr);
}
ierr = PetscFree3(w0,w1,w2);CHKERRQ(ierr);
} else if (ismpiaij) {
Mat Daij,Oaij;
const PetscInt *garray;
PetscInt max_d_nnz;
ierr = MatMPIAIJGetSeqAIJ(Amat,&Daij,&Oaij,&garray);CHKERRQ(ierr);
/*
Determine exact preallocation count for diagonal block portion of scalar matrix
*/
ierr = MatSeqAIJGetMaxRowNonzeros(Daij,&max_d_nnz);CHKERRQ(ierr);
max_d_nnz = PetscMin(nloc,bs*max_d_nnz);CHKERRQ(ierr);
ierr = PetscMalloc3(max_d_nnz, &w0,max_d_nnz, &w1,max_d_nnz, &w2);CHKERRQ(ierr);
for (Ii = 0, jj = 0; Ii < Iend - Istart; Ii += bs, jj++) {
ierr = MatCollapseRows(Daij,Ii,bs,w0,w1,w2,&d_nnz[jj],NULL);CHKERRQ(ierr);
}
ierr = PetscFree3(w0,w1,w2);CHKERRQ(ierr);
/*
Over estimate (usually grossly over), preallocation count for off-diagonal portion of scalar matrix
*/
for (Ii = 0, jj = 0; Ii < Iend - Istart; Ii += bs, jj++) {
o_nnz[jj] = 0;
for (kk=0; kk<bs; kk++) { /* rows that get collapsed to a single row */
ierr = MatGetRow(Oaij,Ii+kk,&ncols,0,0);CHKERRQ(ierr);
o_nnz[jj] += ncols;
ierr = MatRestoreRow(Oaij,Ii+kk,&ncols,0,0);CHKERRQ(ierr);
}
if (o_nnz[jj] > (NN/bs-nloc)) o_nnz[jj] = NN/bs-nloc;
}
} else SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"Require AIJ matrix type");
/* get scalar copy (norms) of matrix */
ierr = MatGetType(Amat,&mtype);CHKERRQ(ierr);
ierr = MatCreate(comm, &Gmat);CHKERRQ(ierr);
ierr = MatSetSizes(Gmat,nloc,nloc,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetBlockSizes(Gmat, 1, 1);CHKERRQ(ierr);
ierr = MatSetType(Gmat, mtype);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(Gmat,0,d_nnz);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(Gmat,0,d_nnz,0,o_nnz);CHKERRQ(ierr);
ierr = PetscFree2(d_nnz,o_nnz);CHKERRQ(ierr);
for (Ii = Istart; Ii < Iend; Ii++) {
PetscInt dest_row = Ii/bs;
ierr = MatGetRow(Amat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
for (jj=0; jj<ncols; jj++) {
PetscInt dest_col = idx[jj]/bs;
PetscScalar sv = PetscAbs(PetscRealPart(vals[jj]));
ierr = MatSetValues(Gmat,1,&dest_row,1,&dest_col,&sv,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatRestoreRow(Amat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(Gmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(Gmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
} else {
/* just copy scalar matrix - abs() not taken here but scaled later */
ierr = MatDuplicate(Amat, MAT_COPY_VALUES, &Gmat);CHKERRQ(ierr);
}
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
*a_Gmat = Gmat;
PetscFunctionReturn(0);
}
PetscErrorCode PCGAMGCreateGraph(const Mat Amat, Mat *a_Gmat)
{
PetscErrorCode ierr;
PetscInt Istart,Iend,Ii,jj,kk,ncols,nloc,NN,MM,bs;
PetscMPIInt rank, size;
MPI_Comm comm;
Mat Gmat;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)Amat,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(Amat, &Istart, &Iend);CHKERRQ(ierr);
ierr = MatGetSize(Amat, &MM, &NN);CHKERRQ(ierr);
ierr = MatGetBlockSize(Amat, &bs);CHKERRQ(ierr);
nloc = (Iend-Istart)/bs;
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
if (bs > 1) {
const PetscScalar *vals;
const PetscInt *idx;
PetscInt *d_nnz, *o_nnz;
/* count nnz, there is sparcity in here so this might not be enough */
ierr = PetscMalloc1(nloc, &d_nnz);CHKERRQ(ierr);
ierr = PetscMalloc1(nloc, &o_nnz);CHKERRQ(ierr);
for (Ii = Istart, jj = 0; Ii < Iend; Ii += bs, jj++) {
d_nnz[jj] = 0;
for (kk=0; kk<bs; kk++) {
ierr = MatGetRow(Amat,Ii+kk,&ncols,0,0);CHKERRQ(ierr);
if (ncols > d_nnz[jj]) {
d_nnz[jj] = ncols; /* very pessimistic but could be too low in theory */
o_nnz[jj] = ncols;
if (d_nnz[jj] > nloc) d_nnz[jj] = nloc;
if (o_nnz[jj] > (NN/bs-nloc)) o_nnz[jj] = NN/bs-nloc;
}
ierr = MatRestoreRow(Amat,Ii+kk,&ncols,0,0);CHKERRQ(ierr);
}
}
/* get scalar copy (norms) of matrix -- AIJ specific!!! */
ierr = MatCreateAIJ(comm, nloc, nloc, PETSC_DETERMINE, PETSC_DETERMINE,0, d_nnz, 0, o_nnz, &Gmat);CHKERRQ(ierr);
ierr = PetscFree(d_nnz);CHKERRQ(ierr);
ierr = PetscFree(o_nnz);CHKERRQ(ierr);
for (Ii = Istart; Ii < Iend; Ii++) {
PetscInt dest_row = Ii/bs;
ierr = MatGetRow(Amat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
for (jj=0; jj<ncols; jj++) {
PetscInt dest_col = idx[jj]/bs;
PetscScalar sv = PetscAbs(PetscRealPart(vals[jj]));
ierr = MatSetValues(Gmat,1,&dest_row,1,&dest_col,&sv,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatRestoreRow(Amat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(Gmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(Gmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
} else {
/* just copy scalar matrix - abs() not taken here but scaled later */
ierr = MatDuplicate(Amat, MAT_COPY_VALUES, &Gmat);CHKERRQ(ierr);
}
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
*a_Gmat = Gmat;
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat Amat;
PetscErrorCode ierr;
SNES snes;
KSP ksp;
MPI_Comm comm;
PetscMPIInt npe,rank;
PetscLogStage stage[7];
PetscBool test_nonzero_cols=PETSC_FALSE,use_nearnullspace=PETSC_TRUE;
Vec xx,bb;
PetscInt iter,i,N,dim=3,cells[3]={1,1,1},max_conv_its,local_sizes[7],run_type=1;
DM dm,distdm,basedm;
PetscBool flg;
char convType[256];
PetscReal Lx,mdisp[10],err[10];
const char * const options[10] = {"-ex56_dm_refine 0",
"-ex56_dm_refine 1",
"-ex56_dm_refine 2",
"-ex56_dm_refine 3",
"-ex56_dm_refine 4",
"-ex56_dm_refine 5",
"-ex56_dm_refine 6",
"-ex56_dm_refine 7",
"-ex56_dm_refine 8",
"-ex56_dm_refine 9"};
PetscFunctionBeginUser;
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
comm = PETSC_COMM_WORLD;
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &npe);CHKERRQ(ierr);
/* options */
ierr = PetscOptionsBegin(comm,NULL,"3D bilinear Q1 elasticity options","");CHKERRQ(ierr);
{
i = 3;
ierr = PetscOptionsIntArray("-cells", "Number of (flux tube) processor in each dimension", "ex56.c", cells, &i, NULL);CHKERRQ(ierr);
Lx = 1.; /* or ne for rod */
max_conv_its = 3;
ierr = PetscOptionsInt("-max_conv_its","Number of iterations in convergence study","",max_conv_its,&max_conv_its,NULL);CHKERRQ(ierr);
if (max_conv_its<=0 || max_conv_its>7) SETERRQ1(PETSC_COMM_WORLD, PETSC_ERR_USER, "Bad number of iterations for convergence test (%D)",max_conv_its);
ierr = PetscOptionsReal("-lx","Length of domain","",Lx,&Lx,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alpha","material coefficient inside circle","",s_soft_alpha,&s_soft_alpha,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-test_nonzero_cols","nonzero test","",test_nonzero_cols,&test_nonzero_cols,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-use_mat_nearnullspace","MatNearNullSpace API test","",use_nearnullspace,&use_nearnullspace,NULL);CHKERRQ(ierr);
ierr = PetscOptionsInt("-run_type","0: twisting load on cantalever, 1: 3rd order accurate convergence test","",run_type,&run_type,NULL);CHKERRQ(ierr);
i = 3;
ierr = PetscOptionsInt("-mat_block_size","","",i,&i,&flg);CHKERRQ(ierr);
if (!flg || i!=3) SETERRQ2(PETSC_COMM_WORLD, PETSC_ERR_USER, "'-mat_block_size 3' must be set (%D) and = 3 (%D)",flg,flg? i : 3);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = PetscLogStageRegister("Mesh Setup", &stage[6]);CHKERRQ(ierr);
ierr = PetscLogStageRegister("1st Setup", &stage[0]);CHKERRQ(ierr);
ierr = PetscLogStageRegister("1st Solve", &stage[1]);CHKERRQ(ierr);
/* create DM, Plex calls DMSetup */
ierr = PetscLogStagePush(stage[6]);CHKERRQ(ierr);
ierr = DMPlexCreateHexBoxMesh(comm, dim, cells, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, &dm);CHKERRQ(ierr);
{
DMLabel label;
IS is;
ierr = DMCreateLabel(dm, "boundary");CHKERRQ(ierr);
ierr = DMGetLabel(dm, "boundary", &label);CHKERRQ(ierr);
ierr = DMPlexMarkBoundaryFaces(dm, label);CHKERRQ(ierr);
if (run_type==0) {
ierr = DMGetStratumIS(dm, "boundary", 1, &is);CHKERRQ(ierr);
ierr = DMCreateLabel(dm,"Faces");CHKERRQ(ierr);
if (is) {
PetscInt d, f, Nf;
const PetscInt *faces;
PetscInt csize;
PetscSection cs;
Vec coordinates ;
DM cdm;
ierr = ISGetLocalSize(is, &Nf);CHKERRQ(ierr);
ierr = ISGetIndices(is, &faces);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
ierr = DMGetDefaultSection(cdm, &cs);CHKERRQ(ierr);
/* Check for each boundary face if any component of its centroid is either 0.0 or 1.0 */
for (f = 0; f < Nf; ++f) {
PetscReal faceCoord;
PetscInt b,v;
PetscScalar *coords = NULL;
PetscInt Nv;
ierr = DMPlexVecGetClosure(cdm, cs, coordinates, faces[f], &csize, &coords);CHKERRQ(ierr);
Nv = csize/dim; /* Calculate mean coordinate vector */
for (d = 0; d < dim; ++d) {
faceCoord = 0.0;
for (v = 0; v < Nv; ++v) faceCoord += PetscRealPart(coords[v*dim+d]);
faceCoord /= Nv;
for (b = 0; b < 2; ++b) {
if (PetscAbs(faceCoord - b) < PETSC_SMALL) { /* domain have not been set yet, still [0,1]^3 */
ierr = DMSetLabelValue(dm, "Faces", faces[f], d*2+b+1);CHKERRQ(ierr);
}
}
}
ierr = DMPlexVecRestoreClosure(cdm, cs, coordinates, faces[f], &csize, &coords);CHKERRQ(ierr);
}
ierr = ISRestoreIndices(is, &faces);CHKERRQ(ierr);
}
ierr = ISDestroy(&is);CHKERRQ(ierr);
ierr = DMGetLabel(dm, "Faces", &label);CHKERRQ(ierr);
ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
}
}
{
PetscInt dimEmbed, i;
PetscInt nCoords;
PetscScalar *coords,bounds[] = {0,Lx,-.5,.5,-.5,.5,}; /* x_min,x_max,y_min,y_max */
Vec coordinates;
if (run_type==1) {
for (i = 0; i < 2*dim; i++) bounds[i] = (i%2) ? 1 : 0;
}
ierr = DMGetCoordinatesLocal(dm,&coordinates);CHKERRQ(ierr);
ierr = DMGetCoordinateDim(dm,&dimEmbed);CHKERRQ(ierr);
if (dimEmbed != dim) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"dimEmbed != dim %D",dimEmbed);CHKERRQ(ierr);
ierr = VecGetLocalSize(coordinates,&nCoords);CHKERRQ(ierr);
if (nCoords % dimEmbed) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Coordinate vector the wrong size");CHKERRQ(ierr);
ierr = VecGetArray(coordinates,&coords);CHKERRQ(ierr);
for (i = 0; i < nCoords; i += dimEmbed) {
PetscInt j;
PetscScalar *coord = &coords[i];
for (j = 0; j < dimEmbed; j++) {
coord[j] = bounds[2 * j] + coord[j] * (bounds[2 * j + 1] - bounds[2 * j]);
}
}
ierr = VecRestoreArray(coordinates,&coords);CHKERRQ(ierr);
ierr = DMSetCoordinatesLocal(dm,coordinates);CHKERRQ(ierr);
}
/* convert to p4est, and distribute */
ierr = PetscOptionsBegin(comm, "", "Mesh conversion options", "DMPLEX");CHKERRQ(ierr);
ierr = PetscOptionsFList("-dm_type","Convert DMPlex to another format (should not be Plex!)","ex56.c",DMList,DMPLEX,convType,256,&flg);CHKERRQ(ierr);
ierr = PetscOptionsEnd();
if (flg) {
DM newdm;
ierr = DMConvert(dm,convType,&newdm);CHKERRQ(ierr);
if (newdm) {
const char *prefix;
PetscBool isForest;
ierr = PetscObjectGetOptionsPrefix((PetscObject)dm,&prefix);CHKERRQ(ierr);
ierr = PetscObjectSetOptionsPrefix((PetscObject)newdm,prefix);CHKERRQ(ierr);
ierr = DMIsForest(newdm,&isForest);CHKERRQ(ierr);
if (isForest) {
} else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_USER, "Converted to non Forest?");
ierr = DMDestroy(&dm);CHKERRQ(ierr);
dm = newdm;
} else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_USER, "Convert failed?");
} else {
/* Plex Distribute mesh over processes */
ierr = DMPlexDistribute(dm, 0, NULL, &distdm);CHKERRQ(ierr);
if (distdm) {
const char *prefix;
ierr = PetscObjectGetOptionsPrefix((PetscObject)dm,&prefix);CHKERRQ(ierr);
ierr = PetscObjectSetOptionsPrefix((PetscObject)distdm,prefix);CHKERRQ(ierr);
ierr = DMDestroy(&dm);CHKERRQ(ierr);
dm = distdm;
}
}
ierr = PetscLogStagePop();CHKERRQ(ierr);
basedm = dm; dm = NULL;
for (iter=0 ; iter<max_conv_its ; iter++) {
ierr = PetscLogStagePush(stage[6]);CHKERRQ(ierr);
/* make new DM */
ierr = DMClone(basedm, &dm);CHKERRQ(ierr);
ierr = PetscObjectSetOptionsPrefix((PetscObject) dm, "ex56_");CHKERRQ(ierr);
ierr = PetscObjectSetName( (PetscObject)dm,"Mesh");CHKERRQ(ierr);
ierr = PetscOptionsClearValue(NULL,"-ex56_dm_refine");CHKERRQ(ierr);
ierr = PetscOptionsInsertString(NULL,options[iter]);CHKERRQ(ierr);
ierr = DMSetFromOptions(dm);CHKERRQ(ierr); /* refinement done here in Plex, p4est */
/* snes */
ierr = SNESCreate(comm, &snes);CHKERRQ(ierr);
ierr = SNESSetDM(snes, dm);CHKERRQ(ierr);
/* fem */
{
const PetscInt Ncomp = dim;
const PetscInt components[] = {0,1,2};
const PetscInt Nfid = 1, Npid = 1;
const PetscInt fid[] = {1}; /* The fixed faces (x=0) */
const PetscInt pid[] = {2}; /* The faces with loading (x=L_x) */
PetscFE fe;
PetscDS prob;
DM cdm = dm;
ierr = PetscFECreateDefault(dm, dim, dim, PETSC_FALSE, NULL, PETSC_DECIDE, &fe);CHKERRQ(ierr); /* elasticity */
ierr = PetscObjectSetName((PetscObject) fe, "deformation");CHKERRQ(ierr);
/* FEM prob */
ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
ierr = PetscDSSetDiscretization(prob, 0, (PetscObject) fe);CHKERRQ(ierr);
/* setup problem */
if (run_type==1) {
ierr = PetscDSSetJacobian(prob, 0, 0, NULL, NULL, NULL, g3_uu_3d);CHKERRQ(ierr);
ierr = PetscDSSetResidual(prob, 0, f0_u_x4, f1_u_3d);CHKERRQ(ierr);
} else {
ierr = PetscDSSetJacobian(prob, 0, 0, NULL, NULL, NULL, g3_uu_3d_alpha);CHKERRQ(ierr);
ierr = PetscDSSetResidual(prob, 0, f0_u, f1_u_3d_alpha);CHKERRQ(ierr);
ierr = PetscDSSetBdResidual(prob, 0, f0_bd_u_3d, f1_bd_u);CHKERRQ(ierr);
}
/* bcs */
if (run_type==1) {
PetscInt id = 1;
ierr = DMAddBoundary(dm, DM_BC_ESSENTIAL, "wall", "boundary", 0, 0, NULL, (void (*)()) zero, 1, &id, NULL);CHKERRQ(ierr);
} else {
ierr = PetscDSAddBoundary(prob, DM_BC_ESSENTIAL, "fixed", "Faces", 0, Ncomp, components, (void (*)()) zero, Nfid, fid, NULL);CHKERRQ(ierr);
ierr = PetscDSAddBoundary(prob, DM_BC_NATURAL, "traction", "Faces", 0, Ncomp, components, NULL, Npid, pid, NULL);CHKERRQ(ierr);
}
while (cdm) {
ierr = DMSetDS(cdm,prob);CHKERRQ(ierr);
ierr = DMGetCoarseDM(cdm, &cdm);CHKERRQ(ierr);
}
ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
}
/* vecs & mat */
ierr = DMCreateGlobalVector(dm,&xx);CHKERRQ(ierr);
ierr = VecDuplicate(xx, &bb);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) bb, "b");CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) xx, "u");CHKERRQ(ierr);
ierr = DMCreateMatrix(dm, &Amat);CHKERRQ(ierr);
ierr = VecGetSize(bb,&N);CHKERRQ(ierr);
local_sizes[iter] = N;
ierr = PetscPrintf(PETSC_COMM_WORLD,"[%d]%s %d global equations, %d vertices\n",rank,PETSC_FUNCTION_NAME,N,N/dim);CHKERRQ(ierr);
if (use_nearnullspace && N/dim > 1) {
/* Set up the near null space (a.k.a. rigid body modes) that will be used by the multigrid preconditioner */
DM subdm;
MatNullSpace nearNullSpace;
PetscInt fields = 0;
PetscObject deformation;
ierr = DMCreateSubDM(dm, 1, &fields, NULL, &subdm);CHKERRQ(ierr);
ierr = DMPlexCreateRigidBody(subdm, &nearNullSpace);CHKERRQ(ierr);
ierr = DMGetField(dm, 0, &deformation);CHKERRQ(ierr);
ierr = PetscObjectCompose(deformation, "nearnullspace", (PetscObject) nearNullSpace);CHKERRQ(ierr);
ierr = DMDestroy(&subdm);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nearNullSpace);CHKERRQ(ierr); /* created by DM and destroyed by Mat */
}
ierr = DMPlexSetSNESLocalFEM(dm,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes, Amat, Amat, NULL, NULL);CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
ierr = DMSetUp(dm);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = PetscLogStagePush(stage[0]);CHKERRQ(ierr);
/* ksp */
ierr = SNESGetKSP(snes, &ksp);CHKERRQ(ierr);
ierr = KSPSetComputeSingularValues(ksp,PETSC_TRUE);CHKERRQ(ierr);
/* test BCs */
ierr = VecZeroEntries(xx);CHKERRQ(ierr);
if (test_nonzero_cols) {
if (rank==0) ierr = VecSetValue(xx,0,1.0,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(xx);CHKERRQ(ierr);
ierr = VecAssemblyEnd(xx);CHKERRQ(ierr);
}
ierr = VecZeroEntries(bb);CHKERRQ(ierr);
ierr = VecGetSize(bb,&i);CHKERRQ(ierr);
local_sizes[iter] = i;
ierr = PetscPrintf(PETSC_COMM_WORLD,"[%d]%s %d equations in vector, %d vertices\n",rank,PETSC_FUNCTION_NAME,i,i/dim);CHKERRQ(ierr);
/* setup solver, dummy solve to really setup */
if (0) {
ierr = KSPSetTolerances(ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
ierr = SNESSolve(snes, bb, xx);CHKERRQ(ierr);
ierr = KSPSetTolerances(ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,50);CHKERRQ(ierr);
ierr = VecZeroEntries(xx);CHKERRQ(ierr);
}
ierr = PetscLogStagePop();CHKERRQ(ierr);
/* solve */
ierr = PetscLogStagePush(stage[1]);CHKERRQ(ierr);
ierr = SNESSolve(snes, bb, xx);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = VecNorm(xx,NORM_INFINITY,&mdisp[iter]);CHKERRQ(ierr);
ierr = DMViewFromOptions(dm, NULL, "-dm_view");CHKERRQ(ierr);
{
PetscViewer viewer = NULL;
PetscViewerFormat fmt;
ierr = PetscOptionsGetViewer(comm,"ex56_","-vec_view",&viewer,&fmt,&flg);CHKERRQ(ierr);
if (flg) {
ierr = PetscViewerPushFormat(viewer,fmt);CHKERRQ(ierr);
ierr = VecView(xx,viewer);CHKERRQ(ierr);
ierr = VecView(bb,viewer);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
}
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
/* Free work space */
ierr = DMDestroy(&dm);CHKERRQ(ierr);
ierr = SNESDestroy(&snes);CHKERRQ(ierr);
ierr = VecDestroy(&xx);CHKERRQ(ierr);
ierr = VecDestroy(&bb);CHKERRQ(ierr);
ierr = MatDestroy(&Amat);CHKERRQ(ierr);
}
ierr = DMDestroy(&basedm);CHKERRQ(ierr);
if (run_type==1) {
err[0] = 59.975208 - mdisp[0]; /* error with what I think is the exact solution */
} else {
err[0] = 171.038 - mdisp[0];
}
for (iter=1 ; iter<max_conv_its ; iter++) {
if (run_type==1) {
err[iter] = 59.975208 - mdisp[iter];
} else {
err[iter] = 171.038 - mdisp[iter];
}
PetscPrintf(PETSC_COMM_WORLD,"[%d]%s %D) N=%12D, max displ=%9.7e, disp diff=%9.2e, error=%4.3e, rate=%3.2g\n",
rank,PETSC_FUNCTION_NAME,iter,local_sizes[iter],mdisp[iter],
mdisp[iter]-mdisp[iter-1],err[iter],log(err[iter-1]/err[iter])/log(2.));
}
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode PCGAMGFilterGraph(Mat *a_Gmat,const PetscReal vfilter,const PetscBool symm,const PetscInt verbose)
{
PetscErrorCode ierr;
PetscInt Istart,Iend,Ii,jj,ncols,nnz0,nnz1, NN, MM, nloc;
PetscMPIInt rank, size;
Mat Gmat = *a_Gmat, tGmat, matTrans;
MPI_Comm comm;
const PetscScalar *vals;
const PetscInt *idx;
PetscInt *d_nnz, *o_nnz;
Vec diag;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)Gmat,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(Gmat, &Istart, &Iend);CHKERRQ(ierr);
nloc = Iend - Istart;
ierr = MatGetSize(Gmat, &MM, &NN);CHKERRQ(ierr);
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
/* scale Gmat so filter works */
ierr = MatGetVecs(Gmat, &diag, 0);CHKERRQ(ierr);
ierr = MatGetDiagonal(Gmat, diag);CHKERRQ(ierr);
ierr = VecReciprocal(diag);CHKERRQ(ierr);
ierr = VecSqrtAbs(diag);CHKERRQ(ierr);
ierr = MatDiagonalScale(Gmat, diag, diag);CHKERRQ(ierr);
ierr = VecDestroy(&diag);CHKERRQ(ierr);
if (symm) {
ierr = MatTranspose(Gmat, MAT_INITIAL_MATRIX, &matTrans);CHKERRQ(ierr);
}
/* filter - dup zeros out matrix */
ierr = PetscMalloc1(nloc, &d_nnz);CHKERRQ(ierr);
ierr = PetscMalloc1(nloc, &o_nnz);CHKERRQ(ierr);
for (Ii = Istart, jj = 0; Ii < Iend; Ii++, jj++) {
ierr = MatGetRow(Gmat,Ii,&ncols,NULL,NULL);CHKERRQ(ierr);
d_nnz[jj] = ncols;
o_nnz[jj] = ncols;
ierr = MatRestoreRow(Gmat,Ii,&ncols,NULL,NULL);CHKERRQ(ierr);
if (symm) {
ierr = MatGetRow(matTrans,Ii,&ncols,NULL,NULL);CHKERRQ(ierr);
d_nnz[jj] += ncols;
o_nnz[jj] += ncols;
ierr = MatRestoreRow(matTrans,Ii,&ncols,NULL,NULL);CHKERRQ(ierr);
}
if (d_nnz[jj] > nloc) d_nnz[jj] = nloc;
if (o_nnz[jj] > (MM-nloc)) o_nnz[jj] = MM - nloc;
}
ierr = MatCreateAIJ(comm, nloc, nloc, MM, MM, 0, d_nnz, 0, o_nnz, &tGmat);CHKERRQ(ierr);
ierr = PetscFree(d_nnz);CHKERRQ(ierr);
ierr = PetscFree(o_nnz);CHKERRQ(ierr);
if (symm) {
ierr = MatDestroy(&matTrans);CHKERRQ(ierr);
}
for (Ii = Istart, nnz0 = nnz1 = 0; Ii < Iend; Ii++) {
ierr = MatGetRow(Gmat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
for (jj=0; jj<ncols; jj++,nnz0++) {
PetscScalar sv = PetscAbs(PetscRealPart(vals[jj]));
if (PetscRealPart(sv) > vfilter) {
nnz1++;
if (symm) {
sv *= 0.5;
ierr = MatSetValues(tGmat,1,&Ii,1,&idx[jj],&sv,ADD_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(tGmat,1,&idx[jj],1,&Ii,&sv,ADD_VALUES);CHKERRQ(ierr);
} else {
ierr = MatSetValues(tGmat,1,&Ii,1,&idx[jj],&sv,ADD_VALUES);CHKERRQ(ierr);
}
}
}
ierr = MatRestoreRow(Gmat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(tGmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(tGmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
if (verbose) {
if (verbose == 1) {
ierr = PetscPrintf(comm,"\t[%d]%s %g%% nnz after filtering, with threshold %g, %g nnz ave. (N=%d)\n",rank,__FUNCT__,
100.*(double)nnz1/(double)nnz0,vfilter,(double)nnz0/(double)nloc,MM);CHKERRQ(ierr);
} else {
PetscInt nnz[2],out[2];
nnz[0] = nnz0; nnz[1] = nnz1;
ierr = MPI_Allreduce(nnz, out, 2, MPIU_INT, MPI_SUM, comm);CHKERRQ(ierr);
ierr = PetscPrintf(comm,"\t[%d]%s %g%% nnz after filtering, with threshold %g, %g nnz ave. (N=%d)\n",rank,__FUNCT__,
100.*(double)out[1]/(double)out[0],vfilter,(double)out[0]/(double)MM,MM);CHKERRQ(ierr);
}
}
ierr = MatDestroy(&Gmat);CHKERRQ(ierr);
*a_Gmat = tGmat;
PetscFunctionReturn(0);
}
PetscErrorCode testCreate3D( )
{
int ga;
DA da;
DALocalInfo info;
Vec vec;
PetscErrorCode ierr;
PetscFunctionBegin;
int d1 = 229, d2 = 229, d3 = 229;
int rank;
MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
ierr = DACreate3d(PETSC_COMM_WORLD,DA_NONPERIODIC,DA_STENCIL_STAR,
d1,d2,d3,
PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,
1,1,
0,0,0, &da); CHKERRQ(ierr);
ierr = DAGetLocalInfo(da,&info); CHKERRQ(ierr);
ierr = DACreateGlobalArray( da, &ga, &vec); CHKERRQ(ierr);
PetscReal ***v;
ierr = DAVecGetArray(da,vec,&v); CHKERRQ(ierr);
int xe = info.xs+info.xm,
ye = info.ys+info.ym,
ze = info.zs+info.zm;
for (int k = info.zs; k < ze; ++k) {
for (int j = info.ys; j < ye; ++j) {
for (int i = info.xs; i < xe; ++i) {
v[k][j][i] = 1.*i + d1*j + d1*d2*k;
}
}
}
ierr = DAVecRestoreArray(da,vec,&v); CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "Sequential values filled in petsc vec.\n"); CHKERRQ(ierr);
ierr = PetscBarrier(0); CHKERRQ(ierr);
int lo[3],ld, p = 10;
int patch[10][10][10];
double val;
for (int k = 0; k < d3; k+=p) {
for (int j = 0; j < d2; j+=p) {
for (int i = 0; i < d1; i+=p) {
lo[0] = k;
lo[1] = j;
lo[2] = i;
NGA_Get(ga,lo,lo,&val,&ld);
if( PetscAbs( i + d1*j + d1*d2*k - val) > .1 )
// printf(".");
printf("(%3.0f,%3.0f) ", 1.*i + d1*j + d1*d2*k, val);
}
}
}
ierr = PetscPrintf(PETSC_COMM_WORLD, "Ended NGA_Get() test.\n"); CHKERRQ(ierr);
ierr = PetscBarrier(0); CHKERRQ(ierr);
if( rank == 0 )
{
for (int k = 0; k < d3; ++k) {
printf(">%d\n",k);
for (int j = 0; j < d2; ++j) {
for (int i = 0; i < d1; ++i) {
lo[0] = k; lo[1] = j; lo[2] = i;
val = 1.*i + d1*j + d1*d2*k;
val *= -1;
NGA_Put(ga,lo,lo,&val,&ld);
}
}
}
}
ierr = PetscPrintf(PETSC_COMM_WORLD, "Ended NGA_Put() negative seq values.\n"); CHKERRQ(ierr);
ierr = PetscBarrier(0); CHKERRQ(ierr);
ierr = DAVecGetArray(da,vec,&v); CHKERRQ(ierr);
for (int k = info.zs; k < ze; ++k) {
for (int j = info.ys; j < ye; ++j) {
for (int i = info.xs; i < xe; ++i) {
val = -1 * (1.*i + d1*j + d1*d2*k);
if( PetscAbs( val - v[k][j][i] ) > .1 )
printf(".");
}
}
}
ierr = DAVecRestoreArray(da,vec,&v); CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "Ended petsc vec update test.\n"); CHKERRQ(ierr);
if( rank == 0 )
GA_Print_stats();
ierr = VecDestroy(vec); CHKERRQ(ierr);
GA_Destroy(ga);
PetscFunctionReturn(0);
}
static PetscErrorCode SNESSolve_QN(SNES snes)
{
PetscErrorCode ierr;
SNES_QN *qn = (SNES_QN*) snes->data;
Vec X,Xold;
Vec F,W;
Vec Y,D,Dold;
PetscInt i, i_r;
PetscReal fnorm,xnorm,ynorm,gnorm;
SNESLineSearchReason lssucceed;
PetscBool powell,periodic;
PetscScalar DolddotD,DolddotDold;
SNESConvergedReason reason;
/* basically just a regular newton's method except for the application of the Jacobian */
PetscFunctionBegin;
if (snes->xl || snes->xu || snes->ops->computevariablebounds) {
SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_ARG_WRONGSTATE, "SNES solver %s does not support bounds", ((PetscObject)snes)->type_name);
}
ierr = PetscCitationsRegister(SNESCitation,&SNEScite);CHKERRQ(ierr);
F = snes->vec_func; /* residual vector */
Y = snes->vec_sol_update; /* search direction generated by J^-1D*/
W = snes->work[3];
X = snes->vec_sol; /* solution vector */
Xold = snes->work[0];
/* directions generated by the preconditioned problem with F_pre = F or x - M(x, b) */
D = snes->work[1];
Dold = snes->work[2];
snes->reason = SNES_CONVERGED_ITERATING;
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->iter = 0;
snes->norm = 0.;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
if (snes->pc && snes->pcside == PC_LEFT && snes->functype == SNES_FUNCTION_PRECONDITIONED) {
ierr = SNESApplyNPC(snes,X,NULL,F);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(snes->pc,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
ierr = VecNorm(F,NORM_2,&fnorm);CHKERRQ(ierr);
} else {
if (!snes->vec_func_init_set) {
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
} else snes->vec_func_init_set = PETSC_FALSE;
ierr = VecNorm(F,NORM_2,&fnorm);CHKERRQ(ierr);
SNESCheckFunctionNorm(snes,fnorm);
}
if (snes->pc && snes->pcside == PC_LEFT && snes->functype == SNES_FUNCTION_UNPRECONDITIONED) {
ierr = SNESApplyNPC(snes,X,F,D);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(snes->pc,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
} else {
ierr = VecCopy(F,D);CHKERRQ(ierr);
}
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->norm = fnorm;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
ierr = SNESLogConvergenceHistory(snes,fnorm,0);CHKERRQ(ierr);
ierr = SNESMonitor(snes,0,fnorm);CHKERRQ(ierr);
/* test convergence */
ierr = (*snes->ops->converged)(snes,0,0.0,0.0,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) PetscFunctionReturn(0);
if (snes->pc && snes->pcside == PC_RIGHT) {
ierr = PetscLogEventBegin(SNES_NPCSolve,snes->pc,X,0,0);CHKERRQ(ierr);
ierr = SNESSolve(snes->pc,snes->vec_rhs,X);CHKERRQ(ierr);
ierr = PetscLogEventEnd(SNES_NPCSolve,snes->pc,X,0,0);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(snes->pc,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
ierr = SNESGetNPCFunction(snes,F,&fnorm);CHKERRQ(ierr);
ierr = VecCopy(F,D);CHKERRQ(ierr);
}
/* scale the initial update */
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = SNESComputeJacobian(snes,X,snes->jacobian,snes->jacobian_pre);CHKERRQ(ierr);
ierr = KSPSetOperators(snes->ksp,snes->jacobian,snes->jacobian_pre);CHKERRQ(ierr);
}
for (i = 0, i_r = 0; i < snes->max_its; i++, i_r++) {
if (qn->scale_type == SNES_QN_SCALE_SHANNO && i_r > 0) {
PetscScalar ff,xf;
ierr = VecCopy(Dold,Y);CHKERRQ(ierr);
ierr = VecCopy(Xold,W);CHKERRQ(ierr);
ierr = VecAXPY(Y,-1.0,D);CHKERRQ(ierr);
ierr = VecAXPY(W,-1.0,X);CHKERRQ(ierr);
ierr = VecDotBegin(Y,Y,&ff);CHKERRQ(ierr);
ierr = VecDotBegin(W,Y,&xf);CHKERRQ(ierr);
ierr = VecDotEnd(Y,Y,&ff);CHKERRQ(ierr);
ierr = VecDotEnd(W,Y,&xf);CHKERRQ(ierr);
qn->scaling = PetscRealPart(xf)/PetscRealPart(ff);
}
switch (qn->type) {
case SNES_QN_BADBROYDEN:
ierr = SNESQNApply_BadBroyden(snes,i_r,Y,X,Xold,D,Dold);CHKERRQ(ierr);
break;
case SNES_QN_BROYDEN:
ierr = SNESQNApply_Broyden(snes,i_r,Y,X,Xold,D);CHKERRQ(ierr);
break;
case SNES_QN_LBFGS:
SNESQNApply_LBFGS(snes,i_r,Y,X,Xold,D,Dold);CHKERRQ(ierr);
break;
}
/* line search for lambda */
ynorm = 1; gnorm = fnorm;
ierr = VecCopy(D, Dold);CHKERRQ(ierr);
ierr = VecCopy(X, Xold);CHKERRQ(ierr);
ierr = SNESLineSearchApply(snes->linesearch, X, F, &fnorm, Y);CHKERRQ(ierr);
if (snes->reason == SNES_DIVERGED_FUNCTION_COUNT) break;
ierr = SNESLineSearchGetReason(snes->linesearch, &lssucceed);CHKERRQ(ierr);
ierr = SNESLineSearchGetNorms(snes->linesearch, &xnorm, &fnorm, &ynorm);CHKERRQ(ierr);
if (lssucceed) {
if (++snes->numFailures >= snes->maxFailures) {
snes->reason = SNES_DIVERGED_LINE_SEARCH;
break;
}
}
if (qn->scale_type == SNES_QN_SCALE_LINESEARCH) {
ierr = SNESLineSearchGetLambda(snes->linesearch, &qn->scaling);CHKERRQ(ierr);
}
/* convergence monitoring */
ierr = PetscInfo4(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lssucceed=%d\n",(double)fnorm,(double)gnorm,(double)ynorm,(int)lssucceed);CHKERRQ(ierr);
if (snes->pc && snes->pcside == PC_RIGHT) {
ierr = PetscLogEventBegin(SNES_NPCSolve,snes->pc,X,0,0);CHKERRQ(ierr);
ierr = SNESSolve(snes->pc,snes->vec_rhs,X);CHKERRQ(ierr);
ierr = PetscLogEventEnd(SNES_NPCSolve,snes->pc,X,0,0);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(snes->pc,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
ierr = SNESGetNPCFunction(snes,F,&fnorm);CHKERRQ(ierr);
}
ierr = SNESSetIterationNumber(snes, i+1);CHKERRQ(ierr);
snes->norm = fnorm;
ierr = SNESLogConvergenceHistory(snes,snes->norm,snes->iter);CHKERRQ(ierr);
ierr = SNESMonitor(snes,snes->iter,snes->norm);CHKERRQ(ierr);
/* set parameter for default relative tolerance convergence test */
ierr = (*snes->ops->converged)(snes,snes->iter,xnorm,ynorm,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) PetscFunctionReturn(0);
if (snes->pc && snes->pcside == PC_LEFT && snes->functype == SNES_FUNCTION_UNPRECONDITIONED) {
ierr = SNESApplyNPC(snes,X,F,D);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(snes->pc,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
} else {
ierr = VecCopy(F, D);CHKERRQ(ierr);
}
powell = PETSC_FALSE;
if (qn->restart_type == SNES_QN_RESTART_POWELL) {
/* check restart by Powell's Criterion: |F^T H_0 Fold| > 0.2 * |Fold^T H_0 Fold| */
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = MatMult(snes->jacobian_pre,Dold,W);CHKERRQ(ierr);
} else {
ierr = VecCopy(Dold,W);CHKERRQ(ierr);
}
ierr = VecDotBegin(W, Dold, &DolddotDold);CHKERRQ(ierr);
ierr = VecDotBegin(W, D, &DolddotD);CHKERRQ(ierr);
ierr = VecDotEnd(W, Dold, &DolddotDold);CHKERRQ(ierr);
ierr = VecDotEnd(W, D, &DolddotD);CHKERRQ(ierr);
if (PetscAbs(PetscRealPart(DolddotD)) > qn->powell_gamma*PetscAbs(PetscRealPart(DolddotDold))) powell = PETSC_TRUE;
}
periodic = PETSC_FALSE;
if (qn->restart_type == SNES_QN_RESTART_PERIODIC) {
if (i_r>qn->m-1) periodic = PETSC_TRUE;
}
/* restart if either powell or periodic restart is satisfied. */
if (powell || periodic) {
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "restart! |%14.12e| > %4.2f*|%14.12e| or i_r = %d\n", PetscRealPart(DolddotD), qn->powell_gamma, PetscRealPart(DolddotDold), i_r);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
i_r = -1;
/* general purpose update */
if (snes->ops->update) {
ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
}
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = SNESComputeJacobian(snes,X,snes->jacobian,snes->jacobian_pre);CHKERRQ(ierr);
}
}
/* general purpose update */
if (snes->ops->update) {
ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
}
}
if (i == snes->max_its) {
ierr = PetscInfo1(snes, "Maximum number of iterations has been reached: %D\n", snes->max_its);CHKERRQ(ierr);
if (!snes->reason) snes->reason = SNES_DIVERGED_MAX_IT;
}
PetscFunctionReturn(0);
}
static PetscErrorCode TaoSolve_TRON(Tao tao)
{
TAO_TRON *tron = (TAO_TRON *)tao->data;
PetscErrorCode ierr;
PetscInt its;
TaoConvergedReason reason = TAO_CONTINUE_ITERATING;
TaoLineSearchConvergedReason ls_reason = TAOLINESEARCH_CONTINUE_ITERATING;
PetscReal prered,actred,delta,f,f_new,rhok,gdx,xdiff,stepsize;
PetscFunctionBegin;
tron->pgstepsize=1.0;
tao->trust = tao->trust0;
/* Project the current point onto the feasible set */
ierr = TaoComputeVariableBounds(tao);CHKERRQ(ierr);
ierr = VecMedian(tao->XL,tao->solution,tao->XU,tao->solution);CHKERRQ(ierr);
ierr = TaoLineSearchSetVariableBounds(tao->linesearch,tao->XL,tao->XU);CHKERRQ(ierr);
ierr = TaoComputeObjectiveAndGradient(tao,tao->solution,&tron->f,tao->gradient);CHKERRQ(ierr);
ierr = ISDestroy(&tron->Free_Local);CHKERRQ(ierr);
ierr = VecWhichBetween(tao->XL,tao->solution,tao->XU,&tron->Free_Local);CHKERRQ(ierr);
/* Project the gradient and calculate the norm */
ierr = VecBoundGradientProjection(tao->gradient,tao->solution, tao->XL, tao->XU, tao->gradient);CHKERRQ(ierr);
ierr = VecNorm(tao->gradient,NORM_2,&tron->gnorm);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(tron->f) || PetscIsInfOrNanReal(tron->gnorm)) SETERRQ(PETSC_COMM_SELF,1, "User provided compute function generated Inf pr NaN");
if (tao->trust <= 0) {
tao->trust=PetscMax(tron->gnorm*tron->gnorm,1.0);
}
tron->stepsize=tao->trust;
ierr = TaoMonitor(tao, tao->niter, tron->f, tron->gnorm, 0.0, tron->stepsize, &reason);CHKERRQ(ierr);
while (reason==TAO_CONTINUE_ITERATING){
tao->ksp_its=0;
ierr = TronGradientProjections(tao,tron);CHKERRQ(ierr);
f=tron->f; delta=tao->trust;
tron->n_free_last = tron->n_free;
ierr = TaoComputeHessian(tao,tao->solution,tao->hessian,tao->hessian_pre);CHKERRQ(ierr);
ierr = ISGetSize(tron->Free_Local, &tron->n_free);CHKERRQ(ierr);
/* If no free variables */
if (tron->n_free == 0) {
actred=0;
ierr = PetscInfo(tao,"No free variables in tron iteration.\n");CHKERRQ(ierr);
ierr = VecNorm(tao->gradient,NORM_2,&tron->gnorm);CHKERRQ(ierr);
ierr = TaoMonitor(tao, tao->niter, tron->f, tron->gnorm, 0.0, delta, &reason);CHKERRQ(ierr);
if (!reason) {
reason = TAO_CONVERGED_STEPTOL;
ierr = TaoSetConvergedReason(tao,reason);CHKERRQ(ierr);
}
break;
}
/* use free_local to mask/submat gradient, hessian, stepdirection */
ierr = TaoVecGetSubVec(tao->gradient,tron->Free_Local,tao->subset_type,0.0,&tron->R);CHKERRQ(ierr);
ierr = TaoVecGetSubVec(tao->gradient,tron->Free_Local,tao->subset_type,0.0,&tron->DXFree);CHKERRQ(ierr);
ierr = VecSet(tron->DXFree,0.0);CHKERRQ(ierr);
ierr = VecScale(tron->R, -1.0);CHKERRQ(ierr);
ierr = TaoMatGetSubMat(tao->hessian, tron->Free_Local, tron->diag, tao->subset_type, &tron->H_sub);CHKERRQ(ierr);
if (tao->hessian == tao->hessian_pre) {
ierr = MatDestroy(&tron->Hpre_sub);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)(tron->H_sub));CHKERRQ(ierr);
tron->Hpre_sub = tron->H_sub;
} else {
ierr = TaoMatGetSubMat(tao->hessian_pre, tron->Free_Local, tron->diag, tao->subset_type,&tron->Hpre_sub);CHKERRQ(ierr);
}
ierr = KSPReset(tao->ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(tao->ksp, tron->H_sub, tron->Hpre_sub);CHKERRQ(ierr);
while (1) {
/* Approximately solve the reduced linear system */
ierr = KSPSTCGSetRadius(tao->ksp,delta);CHKERRQ(ierr);
ierr = KSPSolve(tao->ksp, tron->R, tron->DXFree);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(tao->ksp,&its);CHKERRQ(ierr);
tao->ksp_its+=its;
tao->ksp_tot_its+=its;
ierr = VecSet(tao->stepdirection,0.0);CHKERRQ(ierr);
/* Add dxfree matrix to compute step direction vector */
ierr = VecISAXPY(tao->stepdirection,tron->Free_Local,1.0,tron->DXFree);CHKERRQ(ierr);
if (0) {
PetscReal rhs,stepnorm;
ierr = VecNorm(tron->R,NORM_2,&rhs);CHKERRQ(ierr);
ierr = VecNorm(tron->DXFree,NORM_2,&stepnorm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"|rhs|=%g\t|s|=%g\n",(double)rhs,(double)stepnorm);CHKERRQ(ierr);
}
ierr = VecDot(tao->gradient, tao->stepdirection, &gdx);CHKERRQ(ierr);
ierr = PetscInfo1(tao,"Expected decrease in function value: %14.12e\n",(double)gdx);CHKERRQ(ierr);
ierr = VecCopy(tao->solution, tron->X_New);CHKERRQ(ierr);
ierr = VecCopy(tao->gradient, tron->G_New);CHKERRQ(ierr);
stepsize=1.0;f_new=f;
ierr = TaoLineSearchSetInitialStepLength(tao->linesearch,1.0);CHKERRQ(ierr);
ierr = TaoLineSearchApply(tao->linesearch, tron->X_New, &f_new, tron->G_New, tao->stepdirection,&stepsize,&ls_reason);CHKERRQ(ierr);CHKERRQ(ierr);
ierr = TaoAddLineSearchCounts(tao);CHKERRQ(ierr);
ierr = MatMult(tao->hessian, tao->stepdirection, tron->Work);CHKERRQ(ierr);
ierr = VecAYPX(tron->Work, 0.5, tao->gradient);CHKERRQ(ierr);
ierr = VecDot(tao->stepdirection, tron->Work, &prered);CHKERRQ(ierr);
actred = f_new - f;
if (actred<0) {
rhok=PetscAbs(-actred/prered);
} else {
rhok=0.0;
}
/* Compare actual improvement to the quadratic model */
if (rhok > tron->eta1) { /* Accept the point */
/* d = x_new - x */
ierr = VecCopy(tron->X_New, tao->stepdirection);CHKERRQ(ierr);
ierr = VecAXPY(tao->stepdirection, -1.0, tao->solution);CHKERRQ(ierr);
ierr = VecNorm(tao->stepdirection, NORM_2, &xdiff);CHKERRQ(ierr);
xdiff *= stepsize;
/* Adjust trust region size */
if (rhok < tron->eta2 ){
delta = PetscMin(xdiff,delta)*tron->sigma1;
} else if (rhok > tron->eta4 ){
delta= PetscMin(xdiff,delta)*tron->sigma3;
} else if (rhok > tron->eta3 ){
delta=PetscMin(xdiff,delta)*tron->sigma2;
}
ierr = VecBoundGradientProjection(tron->G_New,tron->X_New, tao->XL, tao->XU, tao->gradient);CHKERRQ(ierr);
if (tron->Free_Local) {
ierr = ISDestroy(&tron->Free_Local);CHKERRQ(ierr);
}
ierr = VecWhichBetween(tao->XL, tron->X_New, tao->XU, &tron->Free_Local);CHKERRQ(ierr);
f=f_new;
ierr = VecNorm(tao->gradient,NORM_2,&tron->gnorm);CHKERRQ(ierr);
ierr = VecCopy(tron->X_New, tao->solution);CHKERRQ(ierr);
ierr = VecCopy(tron->G_New, tao->gradient);CHKERRQ(ierr);
break;
}
else if (delta <= 1e-30) {
break;
}
else {
delta /= 4.0;
}
} /* end linear solve loop */
tron->f=f; tron->actred=actred; tao->trust=delta;
tao->niter++;
ierr = TaoMonitor(tao, tao->niter, tron->f, tron->gnorm, 0.0, delta, &reason);CHKERRQ(ierr);
} /* END MAIN LOOP */
PetscFunctionReturn(0);
}
static PetscErrorCode triangulateAndFormProl(IS selected_2, /* list of selected local ID, includes selected ghosts */
const PetscInt data_stride,
const PetscReal coords[], /* column vector of local coordinates w/ ghosts */
const PetscInt nselected_1, /* list of selected local ID, includes selected ghosts */
const PetscInt clid_lid_1[],
const PetscCoarsenData *agg_lists_1, /* selected_1 vertices of aggregate unselected vertices */
const PetscInt crsGID[],
const PetscInt bs,
Mat a_Prol, /* prolongation operator (output) */
PetscReal *a_worst_best) /* measure of worst missed fine vertex, 0 is no misses */
{
#if defined(PETSC_HAVE_TRIANGLE)
PetscErrorCode ierr;
PetscInt jj,tid,tt,idx,nselected_2;
struct triangulateio in,mid;
const PetscInt *selected_idx_2;
PetscMPIInt rank,size;
PetscInt Istart,Iend,nFineLoc,myFine0;
int kk,nPlotPts,sid;
MPI_Comm comm;
PetscReal tm;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)a_Prol,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = ISGetSize(selected_2, &nselected_2);CHKERRQ(ierr);
if (nselected_2 == 1 || nselected_2 == 2) { /* 0 happens on idle processors */
*a_worst_best = 100.0; /* this will cause a stop, but not globalized (should not happen) */
} else *a_worst_best = 0.0;
ierr = MPI_Allreduce(a_worst_best, &tm, 1, MPIU_REAL, MPIU_MAX, comm);CHKERRQ(ierr);
if (tm > 0.0) {
*a_worst_best = 100.0;
PetscFunctionReturn(0);
}
ierr = MatGetOwnershipRange(a_Prol, &Istart, &Iend);CHKERRQ(ierr);
nFineLoc = (Iend-Istart)/bs; myFine0 = Istart/bs;
nPlotPts = nFineLoc; /* locals */
/* traingle */
/* Define input points - in*/
in.numberofpoints = nselected_2;
in.numberofpointattributes = 0;
/* get nselected points */
ierr = PetscMalloc1(2*(nselected_2), &in.pointlist);CHKERRQ(ierr);
ierr = ISGetIndices(selected_2, &selected_idx_2);CHKERRQ(ierr);
for (kk=0,sid=0; kk<nselected_2; kk++,sid += 2) {
PetscInt lid = selected_idx_2[kk];
in.pointlist[sid] = coords[lid];
in.pointlist[sid+1] = coords[data_stride + lid];
if (lid>=nFineLoc) nPlotPts++;
}
if (sid != 2*nselected_2) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"sid %D != 2*nselected_2 %D",sid,nselected_2);
in.numberofsegments = 0;
in.numberofedges = 0;
in.numberofholes = 0;
in.numberofregions = 0;
in.trianglelist = 0;
in.segmentmarkerlist = 0;
in.pointattributelist = 0;
in.pointmarkerlist = 0;
in.triangleattributelist = 0;
in.trianglearealist = 0;
in.segmentlist = 0;
in.holelist = 0;
in.regionlist = 0;
in.edgelist = 0;
in.edgemarkerlist = 0;
in.normlist = 0;
/* triangulate */
mid.pointlist = 0; /* Not needed if -N switch used. */
/* Not needed if -N switch used or number of point attributes is zero: */
mid.pointattributelist = 0;
mid.pointmarkerlist = 0; /* Not needed if -N or -B switch used. */
mid.trianglelist = 0; /* Not needed if -E switch used. */
/* Not needed if -E switch used or number of triangle attributes is zero: */
mid.triangleattributelist = 0;
mid.neighborlist = 0; /* Needed only if -n switch used. */
/* Needed only if segments are output (-p or -c) and -P not used: */
mid.segmentlist = 0;
/* Needed only if segments are output (-p or -c) and -P and -B not used: */
mid.segmentmarkerlist = 0;
mid.edgelist = 0; /* Needed only if -e switch used. */
mid.edgemarkerlist = 0; /* Needed if -e used and -B not used. */
mid.numberoftriangles = 0;
/* Triangulate the points. Switches are chosen to read and write a */
/* PSLG (p), preserve the convex hull (c), number everything from */
/* zero (z), assign a regional attribute to each element (A), and */
/* produce an edge list (e), a Voronoi diagram (v), and a triangle */
/* neighbor list (n). */
if (nselected_2 != 0) { /* inactive processor */
char args[] = "npczQ"; /* c is needed ? */
triangulate(args, &in, &mid, (struct triangulateio*) NULL);
/* output .poly files for 'showme' */
if (!PETSC_TRUE) {
static int level = 1;
FILE *file; char fname[32];
sprintf(fname,"C%d_%d.poly",level,rank); file = fopen(fname, "w");
/*First line: <# of vertices> <dimension (must be 2)> <# of attributes> <# of boundary markers (0 or 1)>*/
fprintf(file, "%d %d %d %d\n",in.numberofpoints,2,0,0);
/*Following lines: <vertex #> <x> <y> */
for (kk=0,sid=0; kk<in.numberofpoints; kk++,sid += 2) {
fprintf(file, "%d %e %e\n",kk,in.pointlist[sid],in.pointlist[sid+1]);
}
/*One line: <# of segments> <# of boundary markers (0 or 1)> */
fprintf(file, "%d %d\n",0,0);
/*Following lines: <segment #> <endpoint> <endpoint> [boundary marker] */
/* One line: <# of holes> */
fprintf(file, "%d\n",0);
/* Following lines: <hole #> <x> <y> */
/* Optional line: <# of regional attributes and/or area constraints> */
/* Optional following lines: <region #> <x> <y> <attribute> <maximum area> */
fclose(file);
/* elems */
sprintf(fname,"C%d_%d.ele",level,rank); file = fopen(fname, "w");
/* First line: <# of triangles> <nodes per triangle> <# of attributes> */
fprintf(file, "%d %d %d\n",mid.numberoftriangles,3,0);
/* Remaining lines: <triangle #> <node> <node> <node> ... [attributes] */
for (kk=0,sid=0; kk<mid.numberoftriangles; kk++,sid += 3) {
fprintf(file, "%d %d %d %d\n",kk,mid.trianglelist[sid],mid.trianglelist[sid+1],mid.trianglelist[sid+2]);
}
fclose(file);
sprintf(fname,"C%d_%d.node",level,rank); file = fopen(fname, "w");
/* First line: <# of vertices> <dimension (must be 2)> <# of attributes> <# of boundary markers (0 or 1)> */
/* fprintf(file, "%d %d %d %d\n",in.numberofpoints,2,0,0); */
fprintf(file, "%d %d %d %d\n",nPlotPts,2,0,0);
/*Following lines: <vertex #> <x> <y> */
for (kk=0,sid=0; kk<in.numberofpoints; kk++,sid+=2) {
fprintf(file, "%d %e %e\n",kk,in.pointlist[sid],in.pointlist[sid+1]);
}
sid /= 2;
for (jj=0; jj<nFineLoc; jj++) {
PetscBool sel = PETSC_TRUE;
for (kk=0; kk<nselected_2 && sel; kk++) {
PetscInt lid = selected_idx_2[kk];
if (lid == jj) sel = PETSC_FALSE;
}
if (sel) fprintf(file, "%d %e %e\n",sid++,coords[jj],coords[data_stride + jj]);
}
fclose(file);
if (sid != nPlotPts) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"sid %D != nPlotPts %D",sid,nPlotPts);
level++;
}
}
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[FIND_V],0,0,0,0);CHKERRQ(ierr);
#endif
{ /* form P - setup some maps */
PetscInt clid,mm,*nTri,*node_tri;
ierr = PetscMalloc1(nselected_2, &node_tri);CHKERRQ(ierr);
ierr = PetscMalloc1(nselected_2, &nTri);CHKERRQ(ierr);
/* need list of triangles on node */
for (kk=0; kk<nselected_2; kk++) nTri[kk] = 0;
for (tid=0,kk=0; tid<mid.numberoftriangles; tid++) {
for (jj=0; jj<3; jj++) {
PetscInt cid = mid.trianglelist[kk++];
if (nTri[cid] == 0) node_tri[cid] = tid;
nTri[cid]++;
}
}
#define EPS 1.e-12
/* find points and set prolongation */
for (mm = clid = 0; mm < nFineLoc; mm++) {
PetscBool ise;
ierr = PetscCDEmptyAt(agg_lists_1,mm,&ise);CHKERRQ(ierr);
if (!ise) {
const PetscInt lid = mm;
/* for (clid_iterator=0;clid_iterator<nselected_1;clid_iterator++) { */
PetscScalar AA[3][3];
PetscBLASInt N=3,NRHS=1,LDA=3,IPIV[3],LDB=3,INFO;
PetscCDPos pos;
ierr = PetscCDGetHeadPos(agg_lists_1,lid,&pos);CHKERRQ(ierr);
while (pos) {
PetscInt flid;
ierr = PetscLLNGetID(pos, &flid);CHKERRQ(ierr);
ierr = PetscCDGetNextPos(agg_lists_1,lid,&pos);CHKERRQ(ierr);
if (flid < nFineLoc) { /* could be a ghost */
PetscInt bestTID = -1; PetscReal best_alpha = 1.e10;
const PetscInt fgid = flid + myFine0;
/* compute shape function for gid */
const PetscReal fcoord[3] = {coords[flid],coords[data_stride+flid],1.0};
PetscBool haveit =PETSC_FALSE; PetscScalar alpha[3]; PetscInt clids[3];
/* look for it */
for (tid = node_tri[clid], jj=0;
jj < 5 && !haveit && tid != -1;
jj++) {
for (tt=0; tt<3; tt++) {
PetscInt cid2 = mid.trianglelist[3*tid + tt];
PetscInt lid2 = selected_idx_2[cid2];
AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0;
clids[tt] = cid2; /* store for interp */
}
for (tt=0; tt<3; tt++) alpha[tt] = (PetscScalar)fcoord[tt];
/* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */
PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO));
{
PetscBool have=PETSC_TRUE; PetscReal lowest=1.e10;
for (tt = 0, idx = 0; tt < 3; tt++) {
if (PetscRealPart(alpha[tt]) > (1.0+EPS) || PetscRealPart(alpha[tt]) < -EPS) have = PETSC_FALSE;
if (PetscRealPart(alpha[tt]) < lowest) {
lowest = PetscRealPart(alpha[tt]);
idx = tt;
}
}
haveit = have;
}
tid = mid.neighborlist[3*tid + idx];
}
if (!haveit) {
/* brute force */
for (tid=0; tid<mid.numberoftriangles && !haveit; tid++) {
for (tt=0; tt<3; tt++) {
PetscInt cid2 = mid.trianglelist[3*tid + tt];
PetscInt lid2 = selected_idx_2[cid2];
AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0;
clids[tt] = cid2; /* store for interp */
}
for (tt=0; tt<3; tt++) alpha[tt] = fcoord[tt];
/* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */
PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO));
{
PetscBool have=PETSC_TRUE; PetscReal worst=0.0, v;
for (tt=0; tt<3 && have; tt++) {
if (PetscRealPart(alpha[tt]) > 1.0+EPS || PetscRealPart(alpha[tt]) < -EPS) have=PETSC_FALSE;
if ((v=PetscAbs(PetscRealPart(alpha[tt])-0.5)) > worst) worst = v;
}
if (worst < best_alpha) {
best_alpha = worst; bestTID = tid;
}
haveit = have;
}
}
}
if (!haveit) {
if (best_alpha > *a_worst_best) *a_worst_best = best_alpha;
/* use best one */
for (tt=0; tt<3; tt++) {
PetscInt cid2 = mid.trianglelist[3*bestTID + tt];
PetscInt lid2 = selected_idx_2[cid2];
AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0;
clids[tt] = cid2; /* store for interp */
}
for (tt=0; tt<3; tt++) alpha[tt] = fcoord[tt];
/* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */
PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO));
}
/* put in row of P */
for (idx=0; idx<3; idx++) {
PetscScalar shp = alpha[idx];
if (PetscAbs(PetscRealPart(shp)) > 1.e-6) {
PetscInt cgid = crsGID[clids[idx]];
PetscInt jj = cgid*bs, ii = fgid*bs; /* need to gloalize */
for (tt=0; tt < bs; tt++, ii++, jj++) {
ierr = MatSetValues(a_Prol,1,&ii,1,&jj,&shp,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
}
} /* aggregates iterations */
clid++;
} /* a coarse agg */
} /* for all fine nodes */
ierr = ISRestoreIndices(selected_2, &selected_idx_2);CHKERRQ(ierr);
ierr = MatAssemblyBegin(a_Prol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(a_Prol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscFree(node_tri);CHKERRQ(ierr);
ierr = PetscFree(nTri);CHKERRQ(ierr);
}
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[FIND_V],0,0,0,0);CHKERRQ(ierr);
#endif
free(mid.trianglelist);
free(mid.neighborlist);
ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
PetscFunctionReturn(0);
#else
SETERRQ(PetscObjectComm((PetscObject)a_Prol),PETSC_ERR_PLIB,"configure with TRIANGLE to use geometric MG");
#endif
}