PetscErrorCode RunTest(void)
{
PetscInt N = 100;
PetscBool draw = PETSC_FALSE;
PetscReal rnorm;
Mat A;
Vec b,x,r;
KSP ksp;
PC pc;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscOptionsGetInt(0,"-N",&N,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(0,"-draw",&draw,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,N,N);CHKERRQ(ierr);
ierr = MatSetType(A,MATPYTHON);CHKERRQ(ierr);
ierr = MatPythonSetType(A,"example1.py:Laplace1D");CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatGetVecs(A,&x,&b);CHKERRQ(ierr);
ierr = VecSet(b,1);CHKERRQ(ierr);
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = KSPSetType(ksp,KSPPYTHON);CHKERRQ(ierr);
ierr = KSPPythonSetType(ksp,"example1.py:ConjGrad");CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCPYTHON);CHKERRQ(ierr);
ierr = PCPythonSetType(pc,"example1.py:Jacobi");CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,A,A);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
ierr = VecDuplicate(b,&r);CHKERRQ(ierr);
ierr = MatMult(A,x,r);CHKERRQ(ierr);
ierr = VecAYPX(r,-1,b);CHKERRQ(ierr);
ierr = VecNorm(r,NORM_2,&rnorm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"error norm = %g\n",rnorm);CHKERRQ(ierr);
if (draw) {
ierr = VecView(x,PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
ierr = PetscSleep(2);CHKERRQ(ierr);
}
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscInt i,blocks[2],nlocal;
PetscMPIInt size,rank;
PetscScalar value;
Vec x,y;
IS is1,is2;
VecScatter ctx = 0;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
if (size != 2) SETERRQ(PETSC_COMM_SELF,1,"Must run with 2 processors");
/* create two vectors */
if (!rank) nlocal = 8;
else nlocal = 4;
ierr = VecCreate(PETSC_COMM_WORLD,&x);CHKERRQ(ierr);
ierr = VecSetSizes(x,nlocal,12);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,8,&y);CHKERRQ(ierr);
/* create two index sets */
if (!rank) {
blocks[0] = 0; blocks[1] = 2;
} else {
blocks[0] = 1; blocks[1] = 2;
}
ierr = ISCreateBlock(PETSC_COMM_SELF,4,2,blocks,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,8,0,1,&is2);CHKERRQ(ierr);
for (i=0; i<12; i++) {
value = i;
ierr = VecSetValues(x,1,&i,&value,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(x);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x);CHKERRQ(ierr);
ierr = VecScatterCreate(x,is1,y,is2,&ctx);CHKERRQ(ierr);
ierr = VecScatterBegin(ctx,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(ctx,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterDestroy(&ctx);CHKERRQ(ierr);
ierr = PetscSleep(2.0*rank);CHKERRQ(ierr);
ierr = VecView(y,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&y);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
ierr = ISDestroy(&is2);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **argv)
{
PetscDraw draw;
PetscDrawLG lg;
PetscDrawAxis axis;
PetscInt n = 20,i,x = 0,y = 0,width = 300,height = 300,nports = 1;
PetscTruth flg;
const char *xlabel,*ylabel,*toplabel;
PetscReal xd,yd;
PetscDrawViewPorts *ports;
PetscErrorCode ierr;
xlabel = "X-axis Label";toplabel = "Top Label";ylabel = "Y-axis Label";
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-width",&width,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-height",&height,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL,"-nolabels",&flg);CHKERRQ(ierr);
if (flg) {
xlabel = (char *)0; toplabel = (char *)0;
}
ierr = PetscDrawCreate(PETSC_COMM_SELF,0,"Title",x,y,width,height,&draw);CHKERRQ(ierr);
ierr = PetscDrawSetFromOptions(draw);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-nports",&nports,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscDrawViewPortsCreate(draw,nports,&ports);CHKERRQ(ierr);
ierr = PetscDrawViewPortsSet(ports,0);CHKERRQ(ierr);
ierr = PetscDrawLGCreate(draw,1,&lg);CHKERRQ(ierr);
ierr = PetscDrawLGGetAxis(lg,&axis);CHKERRQ(ierr);
ierr = PetscDrawAxisSetColors(axis,PETSC_DRAW_BLACK,PETSC_DRAW_RED,PETSC_DRAW_BLUE);CHKERRQ(ierr);
ierr = PetscDrawAxisSetLabels(axis,toplabel,xlabel,ylabel);CHKERRQ(ierr);
for (i=0; i<n ; i++) {
xd = (PetscReal)(i - 5); yd = xd*xd;
ierr = PetscDrawLGAddPoint(lg,&xd,&yd);CHKERRQ(ierr);
}
ierr = PetscDrawLGIndicateDataPoints(lg);CHKERRQ(ierr);
ierr = PetscDrawLGDraw(lg);CHKERRQ(ierr);
ierr = PetscDrawString(draw,-3.,150.0,PETSC_DRAW_BLUE,"A legend");CHKERRQ(ierr);
ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
ierr = PetscSleep(2);CHKERRQ(ierr);
ierr = PetscDrawViewPortsDestroy(ports);CHKERRQ(ierr);
ierr = PetscDrawLGDestroy(lg);CHKERRQ(ierr);
ierr = PetscDrawDestroy(draw);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **args)
{
PetscErrorCode ierr;
PetscInt m = 4,n = 5,i,j,II,J;
PetscScalar one = 1.0,v;
Vec x;
Mat 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);
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);
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(A,1,&II,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
if (i<m-1) {J = II + n; ierr = MatSetValues(A,1,&II,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
if (j>0) {J = II - 1; ierr = MatSetValues(A,1,&II,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
if (j<n-1) {J = II + 1; ierr = MatSetValues(A,1,&II,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
v = 4.0; ierr = MatSetValues(A,1,&II,1,&II,&v,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
#if defined(PETSC_USE_SOCKET_VIEWER)
ierr = MatView(A,PETSC_VIEWER_SOCKET_WORLD);CHKERRQ(ierr);
#endif
ierr = VecCreateSeq(PETSC_COMM_SELF,m,&x);CHKERRQ(ierr);
ierr = VecSet(x,one);CHKERRQ(ierr);
#if defined(PETSC_USE_SOCKET_VIEWER)
ierr = VecView(x,PETSC_VIEWER_SOCKET_WORLD);CHKERRQ(ierr);
#endif
ierr = PetscSleep(30);CHKERRQ(ierr);
ierr = VecDestroy(x);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
/*@C
PetscSAWsBlock - Blocks on SAWs until a client unblocks
Not Collective
Level: advanced
.seealso: PetscObjectSetName(), PetscObjectSAWsViewOff(), PetscObjectSAWsSetBlock(), PetscObjectSAWsBlock()
@*/
PetscErrorCode PetscSAWsBlock(void)
{
PetscErrorCode ierr;
volatile PetscBool block = PETSC_TRUE;
PetscFunctionBegin;
PetscStackCallSAWs(SAWs_Register,("__Block",(PetscBool*)&block,1,SAWs_WRITE,SAWs_BOOLEAN));
SAWs_Lock();
while (block) {
SAWs_Unlock();
ierr = PetscInfo(NULL,"Blocking on SAWs\n");
ierr = PetscSleep(.3);CHKERRQ(ierr);
SAWs_Lock();
}
SAWs_Unlock();
PetscStackCallSAWs(SAWs_Delete,("__Block"));
ierr = PetscInfo(NULL,"Out of SAWs block\n");
PetscFunctionReturn(0);
}
static PetscErrorCode PetscDrawPause_X(PetscDraw draw)
{
PetscErrorCode ierr;
PetscDraw_X* win = (PetscDraw_X*)draw->data;
PetscFunctionBegin;
if (!win->win) PetscFunctionReturn(0);
if (draw->pause > 0) PetscSleep(draw->pause);
else if (draw->pause == -1) {
PetscDrawButton button;
PetscMPIInt rank;
ierr = MPI_Comm_rank(((PetscObject)draw)->comm,&rank);CHKERRQ(ierr);
if (!rank) {
ierr = PetscDrawGetMouseButton(draw,&button,0,0,0,0);CHKERRQ(ierr);
if (button == PETSC_BUTTON_CENTER) draw->pause = 0;
}
ierr = MPI_Bcast(&draw->pause,1,MPIU_REAL,0,((PetscObject)draw)->comm);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode PetscErrorPrintfDefault(const char format[],...)
{
va_list Argp;
static PetscBool PetscErrorPrintfCalled = PETSC_FALSE;
/*
This function does not call PetscFunctionBegin and PetscFunctionReturn() because
it may be called by PetscStackView().
This function does not do error checking because it is called by the error handlers.
*/
if (!PetscErrorPrintfCalled) {
PetscErrorPrintfCalled = PETSC_TRUE;
/*
On the SGI machines and Cray T3E, if errors are generated "simultaneously" by
different processors, the messages are printed all jumbled up; to try to
prevent this we have each processor wait based on their rank
*/
#if defined(PETSC_CAN_SLEEP_AFTER_ERROR)
{
PetscMPIInt rank;
if (PetscGlobalRank > 8) rank = 8;
else rank = PetscGlobalRank;
PetscSleep((PetscReal)rank);
}
#endif
}
PetscFPrintf(PETSC_COMM_SELF,PETSC_STDERR,"[%d]PETSC ERROR: ",PetscGlobalRank);
va_start(Argp,format);
(*PetscVFPrintf)(PETSC_STDERR,format,Argp);
va_end(Argp);
return 0;
}
PetscErrorCode waitForSignal(PetscInt waitTime)
{
PetscErrorCode ierr;
FILE *fd1;
PetscViewer fd;
PetscInt iDone=0;
PetscInt zero=0;
PetscInt one=1;
PetscInt fp;
PetscInt numsignalfiles = 2;
PetscTruth flg;
if (firstTime) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Initializing signaling module ...\n");CHKERRQ(ierr);
ierr = PetscOptionsGetString(PETSC_NULL,"-signalscript",externalSignalScriptName,PETSC_MAX_PATH_LEN-1,&useExternalSignalScript);CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL,"-signalfiles",&useSignalFiles);CHKERRQ(ierr);
if ((useExternalSignalScript) && (useSignalFiles)) {
SETERRQ(1,"Cannot specify both an external signal script and signal files!");
}
if ((!useExternalSignalScript) && (!useSignalFiles)) {
SETERRQ(1,"Must specify an external signal script OR signal files!");
}
if (useExternalSignalScript) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"External signaling script has been specified: %s\n",externalSignalScriptName);CHKERRQ(ierr);
}
if (useSignalFiles) {
ierr = PetscOptionsGetStringArray(PETSC_NULL,"-signalfiles",signalfiles,&numsignalfiles,&flg);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Signal files have been specified: %s, %s\n",signalfiles[0],signalfiles[1]);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-signalwaittime",&signalWaitTime,&flg);CHKERRQ(ierr);
if (flg) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Signal wait time of %d seconds has been specified\n",signalWaitTime);CHKERRQ(ierr);
} else {
signalWaitTime = -1;
}
}
firstTime = PETSC_FALSE;
} else {
if (useExternalSignalScript) {
ierr = PetscPOpen(PETSC_COMM_WORLD,PETSC_NULL,externalSignalScriptName,"r",&fd1);CHKERRQ(ierr);
ierr = PetscPClose(PETSC_COMM_WORLD,fd1);CHKERRQ(ierr);
} else {
if (signalWaitTime>0) waitTime = signalWaitTime; /* overwrite with runtime option */
/* overwrite external signal file */
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,signalfiles[1],FILE_MODE_WRITE,&fd);CHKERRQ(ierr);
ierr = PetscViewerBinaryGetDescriptor(fd,&fp);CHKERRQ(ierr);
ierr = PetscBinarySynchronizedWrite(PETSC_COMM_WORLD,fp,&zero,1,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscViewerDestroy(fd);CHKERRQ(ierr);
/* send "ready" signal */
ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,signalfiles[0],&fd);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(fd,"%d\n",one);CHKERRQ(ierr);
ierr = PetscViewerDestroy(fd);CHKERRQ(ierr);
/* wait for external signal */
while (iDone==0) {
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,signalfiles[1],FILE_MODE_READ,&fd);CHKERRQ(ierr);
ierr = PetscViewerBinaryGetDescriptor(fd,&fp);CHKERRQ(ierr);
ierr = PetscBinarySynchronizedRead(PETSC_COMM_WORLD,fp,&iDone,1,PETSC_INT);CHKERRQ(ierr);
ierr = PetscViewerDestroy(fd);CHKERRQ(ierr);
PetscSleep(waitTime);
}
/* send "busy" signal */
ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,signalfiles[0],&fd);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(fd,"%d\n",zero);CHKERRQ(ierr);
ierr = PetscViewerDestroy(fd);CHKERRQ(ierr);
}
}
return 0;
}
int main(int argc,char **argv)
{
TS ts; /* nonlinear solver */
Vec x,r; /* solution, residual vectors */
Mat J; /* Jacobian matrix */
PetscInt steps,Mx,maxsteps = 10000000;
PetscErrorCode ierr;
DM da;
MatFDColoring matfdcoloring;
ISColoring iscoloring;
PetscReal dt;
PetscReal vbounds[] = {-100000,100000,-1.1,1.1};
PetscBool wait;
Vec ul,uh;
SNES snes;
UserCtx ctx;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ctx.kappa = 1.0;
ierr = PetscOptionsGetReal(NULL,"-kappa",&ctx.kappa,NULL);CHKERRQ(ierr);
ctx.cahnhillard = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,NULL,"-cahn-hillard",&ctx.cahnhillard,NULL);CHKERRQ(ierr);
ierr = PetscViewerDrawSetBounds(PETSC_VIEWER_DRAW_(PETSC_COMM_WORLD),2,vbounds);CHKERRQ(ierr);
ierr = PetscViewerDrawResize(PETSC_VIEWER_DRAW_(PETSC_COMM_WORLD),600,600);CHKERRQ(ierr);
ctx.energy = 1;
/* ierr = PetscOptionsGetInt(NULL,NULL,"-energy",&ctx.energy,NULL);CHKERRQ(ierr); */
ierr = PetscOptionsGetInt(NULL,NULL,"-energy",&ctx.energy,NULL);CHKERRQ(ierr);
ctx.tol = 1.0e-8;
ierr = PetscOptionsGetReal(NULL,"-tol",&ctx.tol,NULL);CHKERRQ(ierr);
ctx.theta = .001;
ctx.theta_c = 1.0;
ierr = PetscOptionsGetReal(NULL,"-theta",&ctx.theta,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-theta_c",&ctx.theta_c,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate1d(PETSC_COMM_WORLD, DM_BOUNDARY_PERIODIC, -10,2,2,NULL,&da);CHKERRQ(ierr);
ierr = DMSetFromOptions(da);CHKERRQ(ierr);
ierr = DMSetUp(da);CHKERRQ(ierr);
ierr = DMDASetFieldName(da,0,"Biharmonic heat equation: w = -kappa*u_xx");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,1,"Biharmonic heat equation: u");CHKERRQ(ierr);
ierr = DMDAGetInfo(da,0,&Mx,0,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
dt = 1.0/(10.*ctx.kappa*Mx*Mx*Mx*Mx);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DMDA; then duplicate for remaining
vectors that are the same types
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&r);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,FormFunction,&ctx);CHKERRQ(ierr);
ierr = TSSetDuration(ts,maxsteps,.02);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create matrix data structure; set Jacobian evaluation routine
< Set Jacobian matrix data structure and default Jacobian evaluation
routine. User can override with:
-snes_mf : matrix-free Newton-Krylov method with no preconditioning
(unless user explicitly sets preconditioner)
-snes_mf_operator : form preconditioning matrix as set by the user,
but use matrix-free approx for Jacobian-vector
products within Newton-Krylov method
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = DMCreateColoring(da,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr);
ierr = DMSetMatType(da,MATAIJ);CHKERRQ(ierr);
ierr = DMCreateMatrix(da,&J);CHKERRQ(ierr);
ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(matfdcoloring,(PetscErrorCode (*)(void))SNESTSFormFunction,ts);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(J,iscoloring,matfdcoloring);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefaultColor,matfdcoloring);CHKERRQ(ierr);
{
ierr = VecDuplicate(x,&ul);CHKERRQ(ierr);
ierr = VecDuplicate(x,&uh);CHKERRQ(ierr);
ierr = VecStrideSet(ul,0,PETSC_NINFINITY);CHKERRQ(ierr);
ierr = VecStrideSet(ul,1,-1.0);CHKERRQ(ierr);
ierr = VecStrideSet(uh,0,PETSC_INFINITY);CHKERRQ(ierr);
ierr = VecStrideSet(uh,1,1.0);CHKERRQ(ierr);
ierr = TSVISetVariableBounds(ts,ul,uh);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Customize nonlinear solver
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(da,x,ctx.kappa);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSSetSolution(ts,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,x);CHKERRQ(ierr);
wait = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,NULL,"-wait",&wait,NULL);CHKERRQ(ierr);
if (wait) {
ierr = PetscSleep(-1);CHKERRQ(ierr);
}
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
{
ierr = VecDestroy(&ul);CHKERRQ(ierr);
ierr = VecDestroy(&uh);CHKERRQ(ierr);
}
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
static PetscErrorCode PetscDrawPause_Win32(PetscDraw draw)
{
PetscFunctionBegin;
PetscSleep(draw->pause);
PetscFunctionReturn(0);
}
/*@C
PetscStopForDebugger - Prints a message to the screen indicating how to
attach to the process with the debugger and then waits for the
debugger to attach.
Not Collective
Level: developer
Notes: This is likely never needed since PetscAttachDebugger() is easier to use and seems to always work.
Developer Notes: Since this can be called by the error handler, should it be calling SETERRQ() and CHKERRQ()?
Concepts: debugger^waiting for attachment
.seealso: PetscSetDebugger(), PetscAttachDebugger()
@*/
PetscErrorCode PetscStopForDebugger(void)
{
PetscErrorCode ierr;
PetscInt sleeptime=0;
#if !defined(PETSC_CANNOT_START_DEBUGGER)
int ppid;
PetscMPIInt rank;
char program[PETSC_MAX_PATH_LEN],hostname[256];
PetscBool isdbx,isxldb,isxxgdb,isddd,iskdbg,isups,isxdb,islldb;
#endif
PetscFunctionBegin;
#if defined(PETSC_CANNOT_START_DEBUGGER)
(*PetscErrorPrintf)("System cannot start debugger; just continuing program\n");
#else
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
if (ierr) rank = 0; /* ignore error since this may be already in error handler */
ierr = PetscGetHostName(hostname,256);
if (ierr) {
(*PetscErrorPrintf)("Cannot determine hostname; just continuing program\n");
PetscFunctionReturn(0);
}
ierr = PetscGetProgramName(program,256);
if (ierr) {
(*PetscErrorPrintf)("Cannot determine program name; just continuing program\n");
PetscFunctionReturn(0);
}
if (!program[0]) {
(*PetscErrorPrintf)("Cannot determine program name; just continuing program\n");
PetscFunctionReturn(0);
}
ppid = getpid();
ierr = PetscStrcmp(Debugger,"xxgdb",&isxxgdb);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"ddd",&isddd);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"kdbg",&iskdbg);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"ups",&isups);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"xldb",&isxldb);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"xdb",&isxdb);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"dbx",&isdbx);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"lldb",&islldb);CHKERRQ(ierr);
if (isxxgdb || isups || isddd || iskdbg) (*PetscErrorPrintf)("[%d]%s>>%s %s %d\n",rank,hostname,Debugger,program,ppid);
else if (isxldb) (*PetscErrorPrintf)("[%d]%s>>%s -a %d %s\n",rank,hostname,Debugger,ppid,program);
else if (islldb) (*PetscErrorPrintf)("[%d]%s>>%s -p %d\n",rank,hostname,Debugger,ppid);
else if (isdbx) {
#if defined(PETSC_USE_P_FOR_DEBUGGER)
(*PetscErrorPrintf)("[%d]%s>>%s -p %d %s\n",rank,hostname,Debugger,ppid,program);
#elif defined(PETSC_USE_LARGEP_FOR_DEBUGGER)
(*PetscErrorPrintf)("[%d]%s>>%s -l ALL -P %d %s\n",rank,hostname,Debugger,ppid,program);
#elif defined(PETSC_USE_A_FOR_DEBUGGER)
(*PetscErrorPrintf)("[%d]%s>>%s -a %d\n",rank,hostname,Debugger,ppid);
#elif defined(PETSC_USE_PID_FOR_DEBUGGER)
(*PetscErrorPrintf)("[%d]%s>>%s -pid %d %s\n",rank,hostname,Debugger,ppid,program);
#else
(*PetscErrorPrintf)("[%d]%s>>%s %s %d\n",rank,hostname,Debugger,program,ppid);
#endif
}
#endif /* PETSC_CANNOT_START_DEBUGGER */
fflush(stdout); /* ignore error because may already be in error handler */
sleeptime = 25; /* default to sleep waiting for debugger */
PetscOptionsGetInt(NULL,"-debugger_pause",&sleeptime,NULL); /* ignore error because may already be in error handler */
if (sleeptime < 0) sleeptime = -sleeptime;
#if defined(PETSC_NEED_DEBUGGER_NO_SLEEP)
/*
HP cannot attach process to sleeping debugger, hence count instead
*/
{
PetscReal x = 1.0;
int i =10000000;
while (i--) x++; /* cannot attach to sleeper */
}
#elif defined(PETSC_HAVE_SLEEP_RETURNS_EARLY)
/*
IBM sleep may return at anytime, hence must see if there is more time to sleep
*/
{
int left = sleeptime;
while (left > 0) left = sleep(left) - 1;
}
#else
PetscSleep(sleeptime);
#endif
PetscFunctionReturn(0);
}
/*@
PetscAttachDebugger - Attaches the debugger to the running process.
Not Collective
Level: advanced
Concepts: debugger^starting from program
Developer Notes: Since this can be called by the error handler should it be calling SETERRQ() and CHKERRQ()?
.seealso: PetscSetDebugger()
@*/
PetscErrorCode PetscAttachDebugger(void)
{
#if !defined(PETSC_CANNOT_START_DEBUGGER)
int child =0;
PetscReal sleeptime=0;
PetscErrorCode ierr;
char program[PETSC_MAX_PATH_LEN],display[256],hostname[64];
#endif
PetscFunctionBegin;
#if defined(PETSC_CANNOT_START_DEBUGGER) || !defined(PETSC_HAVE_FORK)
(*PetscErrorPrintf)("System cannot start debugger\n");
(*PetscErrorPrintf)("On Cray run program in Totalview debugger\n");
(*PetscErrorPrintf)("On Windows use Developer Studio(MSDEV)\n");
MPI_Abort(PETSC_COMM_WORLD,1);
#else
ierr = PetscGetDisplay(display,128);CHKERRQ(ierr);
ierr = PetscGetProgramName(program,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
if (ierr) {
(*PetscErrorPrintf)("Cannot determine program name\n");
PetscFunctionReturn(1);
}
if (!program[0]) {
(*PetscErrorPrintf)("Cannot determine program name\n");
PetscFunctionReturn(1);
}
child = (int)fork();
if (child < 0) {
(*PetscErrorPrintf)("Error in fork() attaching debugger\n");
PetscFunctionReturn(1);
}
/*
Swap role the parent and child. This is (I think) so that control c typed
in the debugger goes to the correct process.
*/
if (child) child = 0;
else child = (int)getppid();
if (child) { /* I am the parent, will run the debugger */
const char *args[10];
char pid[10];
PetscInt j,jj;
PetscBool isdbx,isidb,isxldb,isxxgdb,isups,isxdb,isworkshop,isddd,iskdbg,islldb;
ierr = PetscGetHostName(hostname,64);CHKERRQ(ierr);
/*
We need to send a continue signal to the "child" process on the
alpha, otherwise it just stays off forever
*/
#if defined(PETSC_NEED_KILL_FOR_DEBUGGER)
kill(child,SIGCONT);
#endif
sprintf(pid,"%d",child);
ierr = PetscStrcmp(Debugger,"xxgdb",&isxxgdb);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"ddd",&isddd);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"kdbg",&iskdbg);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"ups",&isups);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"xldb",&isxldb);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"xdb",&isxdb);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"dbx",&isdbx);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"idb",&isidb);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"workshop",&isworkshop);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"lldb",&islldb);CHKERRQ(ierr);
if (isxxgdb || isups || isddd) {
args[1] = program; args[2] = pid; args[3] = "-display";
args[0] = Debugger; args[4] = display; args[5] = 0;
(*PetscErrorPrintf)("PETSC: Attaching %s to %s %s on %s\n",args[0],args[1],pid,hostname);
if (execvp(args[0],(char**)args) < 0) {
perror("Unable to start debugger");
exit(0);
}
} else if (iskdbg) {
args[1] = "-p"; args[2] = pid; args[3] = program; args[4] = "-display";
args[0] = Debugger; args[5] = display; args[6] = 0;
(*PetscErrorPrintf)("PETSC: Attaching %s to %s %s on %s\n",args[0],args[3],pid,hostname);
if (execvp(args[0],(char**)args) < 0) {
perror("Unable to start debugger");
exit(0);
}
} else if (isxldb) {
args[1] = "-a"; args[2] = pid; args[3] = program; args[4] = "-display";
args[0] = Debugger; args[5] = display; args[6] = 0;
(*PetscErrorPrintf)("PETSC: Attaching %s to %s %s on %s\n",args[0],args[1],pid,hostname);
if (execvp(args[0],(char**)args) < 0) {
perror("Unable to start debugger");
exit(0);
}
} else if (isworkshop) {
args[1] = "-s"; args[2] = pid; args[3] = "-D"; args[4] = "-";
args[0] = Debugger; args[5] = pid; args[6] = "-display"; args[7] = display; args[8] = 0;
(*PetscErrorPrintf)("PETSC: Attaching %s to %s on %s\n",args[0],pid,hostname);
if (execvp(args[0],(char**)args) < 0) {
perror("Unable to start debugger");
exit(0);
}
} else {
j = 0;
if (Xterm) {
PetscBool cmp;
char *tmp,*tmp1;
ierr = PetscStrncmp(DebugTerminal,"screen",6,&cmp);CHKERRQ(ierr);
if (cmp) display[0] = 0; /* when using screen, we never pass -display */
args[j++] = tmp = DebugTerminal;
if (display[0]) {
args[j++] = "-display"; args[j++] = display;
}
while (*tmp) {
ierr = PetscStrchr(tmp,' ',&tmp1);CHKERRQ(ierr);
if (!tmp1) break;
*tmp1 = 0;
tmp = tmp1+1;
args[j++] = tmp;
}
}
args[j++] = Debugger;
jj = j;
args[j++] = program; args[j++] = pid; args[j++] = 0;
if (isidb) {
j = jj;
args[j++] = "-pid";
args[j++] = pid;
args[j++] = "-gdb";
args[j++] = program;
args[j++] = 0;
}
if (islldb) {
j = jj;
args[j++] = "-p";
args[j++] = pid;
args[j++] = 0;
}
if (isdbx) {
j = jj;
#if defined(PETSC_USE_P_FOR_DEBUGGER)
args[j++] = "-p";
args[j++] = pid;
args[j++] = program;
#elif defined(PETSC_USE_LARGEP_FOR_DEBUGGER)
args[j++] = "-l";
args[j++] = "ALL";
args[j++] = "-P";
args[j++] = pid;
args[j++] = program;
#elif defined(PETSC_USE_A_FOR_DEBUGGER)
args[j++] = "-a";
args[j++] = pid;
#elif defined(PETSC_USE_PID_FOR_DEBUGGER)
args[j++] = "-pid";
args[j++] = pid;
args[j++] = program;
#endif
args[j++] = 0;
}
if (Xterm) {
if (display[0]) (*PetscErrorPrintf)("PETSC: Attaching %s to %s of pid %s on display %s on machine %s\n",Debugger,program,pid,display,hostname);
else (*PetscErrorPrintf)("PETSC: Attaching %s to %s on pid %s on %s\n",Debugger,program,pid,hostname);
if (execvp(args[0],(char**)args) < 0) {
perror("Unable to start debugger in xterm");
exit(0);
}
} else {
(*PetscErrorPrintf)("PETSC: Attaching %s to %s of pid %s on %s\n",Debugger,program,pid,hostname);
if (execvp(args[0],(char**)args) < 0) {
perror("Unable to start debugger");
exit(0);
}
}
}
} else { /* I am the child, continue with user code */
sleeptime = 10; /* default to sleep waiting for debugger */
ierr = PetscOptionsGetReal(NULL,"-debugger_pause",&sleeptime,NULL);CHKERRQ(ierr);
if (sleeptime < 0) sleeptime = -sleeptime;
#if defined(PETSC_NEED_DEBUGGER_NO_SLEEP)
/*
HP cannot attach process to sleeping debugger, hence count instead
*/
{
PetscReal x = 1.0;
int i =10000000;
while (i--) x++; /* cannot attach to sleeper */
}
#elif defined(PETSC_HAVE_SLEEP_RETURNS_EARLY)
/*
IBM sleep may return at anytime, hence must see if there is more time to sleep
*/
{
int left = sleeptime;
while (left > 0) left = PetscSleep(left) - 1;
}
#else
PetscSleep(sleeptime);
#endif
}
#endif
PetscFunctionReturn(0);
}
int main(int argc, char *argv[])
{
PetscViewer viewer;
Vec u;
PetscScalar v;
int VECTOR_GENERATE, VECTOR_READ;
int i, m = 10, rank, size, low, high, ldim, iglobal;
int ierr;
ierr = PetscInitialize(&argc, &argv, NULL, help);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD, &rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD, &size);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL, "-m", &m, NULL);CHKERRQ(ierr);
/* PART 1: Generate vector, then write it to Mathematica */
ierr = PetscLogEventRegister("Generate Vector", VEC_CLASSID,&VECTOR_GENERATE);CHKERRQ(ierr);
ierr = PetscLogEventBegin(VECTOR_GENERATE, 0, 0, 0, 0);CHKERRQ(ierr);
/* Generate vector */
ierr = VecCreate(PETSC_COMM_WORLD, &u);CHKERRQ(ierr);
ierr = VecSetSizes(u, PETSC_DECIDE, m);CHKERRQ(ierr);
ierr = VecSetFromOptions(u);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(u, &low, &high);CHKERRQ(ierr);
ierr = VecGetLocalSize(u, &ldim);CHKERRQ(ierr);
for (i = 0; i < ldim; i++) {
iglobal = i + low;
v = (PetscScalar) (i + 100*rank);
ierr = VecSetValues(u, 1, &iglobal, &v, INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(u);CHKERRQ(ierr);
ierr = VecAssemblyEnd(u);CHKERRQ(ierr);
ierr = VecView(u, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "writing vector to Mathematica...\n");CHKERRQ(ierr);
#if 0
ierr = PetscViewerMathematicaOpen(PETSC_COMM_WORLD, 8000, "192.168.119.1", "Connect", &viewer);CHKERRQ(ierr);
ierr = VecView(u, viewer);CHKERRQ(ierr);
#else
ierr = VecView(u, PETSC_VIEWER_MATHEMATICA_WORLD);CHKERRQ(ierr);
#endif
v = 0.0;
ierr = VecSet(u,v);CHKERRQ(ierr);
ierr = PetscLogEventEnd(VECTOR_GENERATE, 0, 0, 0, 0);CHKERRQ(ierr);
/* All processors wait until test vector has been dumped */
ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr);
ierr = PetscSleep(10);CHKERRQ(ierr);
/* PART 2: Read in vector in from Mathematica */
ierr = PetscLogEventRegister("Read Vector", VEC_CLASSID,&VECTOR_READ);CHKERRQ(ierr);
ierr = PetscLogEventBegin(VECTOR_READ, 0, 0, 0, 0);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "reading vector from Mathematica...\n");CHKERRQ(ierr);
/* Read new vector in binary format */
#if 0
ierr = PetscViewerMathematicaGetVector(viewer, u);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
#else
ierr = PetscViewerMathematicaGetVector(PETSC_VIEWER_MATHEMATICA_WORLD, u);CHKERRQ(ierr);
#endif
ierr = PetscLogEventEnd(VECTOR_READ, 0, 0, 0, 0);CHKERRQ(ierr);
ierr = VecView(u, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* Free data structures */
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
/*@C
PetscTraceBackErrorHandler - Default error handler routine that generates
a traceback on error detection.
Not Collective
Input Parameters:
+ comm - communicator over which error occurred
. line - the line number of the error (indicated by __LINE__)
. func - the function where error is detected (indicated by __FUNCT__)
. file - the file in which the error was detected (indicated by __FILE__)
. dir - the directory of the file (indicated by __SDIR__)
. mess - an error text string, usually just printed to the screen
. n - the generic error number
. p - PETSC_ERROR_INITIAL if this is the first call the the error handler, otherwise PETSC_ERROR_REPEAT
- ctx - error handler context
Level: developer
Notes:
Most users need not directly employ this routine and the other error
handlers, but can instead use the simplified interface SETERRQ, which has
the calling sequence
$ SETERRQ(comm,number,n,mess)
Notes for experienced users:
Use PetscPushErrorHandler() to set the desired error handler. The
currently available PETSc error handlers include PetscTraceBackErrorHandler(),
PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler()
Concepts: error handler^traceback
Concepts: traceback^generating
.seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
PetscAbortErrorHandler()
@*/
PetscErrorCode PetscTraceBackErrorHandler(MPI_Comm comm,int line,const char *fun,const char* file,const char *dir,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
{
PetscLogDouble mem,rss;
PetscBool flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE;
PetscMPIInt rank = 0;
PetscFunctionBegin;
if (comm != PETSC_COMM_SELF) {
MPI_Comm_rank(comm,&rank);
}
if (!rank) {
if (p == PETSC_ERROR_INITIAL) {
(*PetscErrorPrintf)("--------------------- Error Message ------------------------------------\n");
if (n == PETSC_ERR_MEM) {
(*PetscErrorPrintf)("Out of memory. This could be due to allocating\n");
(*PetscErrorPrintf)("too large an object or bleeding by not properly\n");
(*PetscErrorPrintf)("destroying unneeded objects.\n");
PetscMallocGetCurrentUsage(&mem);
PetscMemoryGetCurrentUsage(&rss);
PetscOptionsGetBool(PETSC_NULL,"-malloc_dump",&flg1,PETSC_NULL);
PetscOptionsGetBool(PETSC_NULL,"-malloc_log",&flg2,PETSC_NULL);
PetscOptionsHasName(PETSC_NULL,"-malloc_log_threshold",&flg3);
if (flg2 || flg3) {
PetscMallocDumpLog(stdout);
} else {
(*PetscErrorPrintf)("Memory allocated %.0f Memory used by process %.0f\n",mem,rss);
if (flg1) {
PetscMallocDump(stdout);
} else {
(*PetscErrorPrintf)("Try running with -malloc_dump or -malloc_log for info.\n");
}
}
} else {
const char *text;
PetscErrorMessage(n,&text,PETSC_NULL);
if (text) (*PetscErrorPrintf)("%s!\n",text);
}
if (mess) {
(*PetscErrorPrintf)("%s!\n",mess);
}
(*PetscErrorPrintf)("------------------------------------------------------------------------\n");
(*PetscErrorPrintf)("%s\n",version);
(*PetscErrorPrintf)("See docs/changes/index.html for recent updates.\n");
(*PetscErrorPrintf)("See docs/faq.html for hints about trouble shooting.\n");
(*PetscErrorPrintf)("See docs/index.html for manual pages.\n");
(*PetscErrorPrintf)("------------------------------------------------------------------------\n");
if (PetscErrorPrintfInitializeCalled) {
(*PetscErrorPrintf)("%s on a %s named %s by %s %s\n",pname,arch,hostname,username,date);
}
(*PetscErrorPrintf)("Libraries linked from %s\n",PETSC_LIB_DIR);
(*PetscErrorPrintf)("Configure run at %s\n",petscconfigureruntime);
(*PetscErrorPrintf)("Configure options %s\n",petscconfigureoptions);
(*PetscErrorPrintf)("------------------------------------------------------------------------\n");
}
/* print line of stack trace */
(*PetscErrorPrintf)("%s() line %d in %s%s\n",fun,line,dir,file);
} else {
/* do not print error messages since process 0 will print them, sleep before aborting so will not accidently kill process 0*/
PetscSleep(10.0);
abort();
}
PetscFunctionReturn(n);
}
PetscErrorCode PetscOptionsCheckInitial_Private(void)
{
char string[64],mname[PETSC_MAX_PATH_LEN],*f;
MPI_Comm comm = PETSC_COMM_WORLD;
PetscBool flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE,flag;
PetscErrorCode ierr;
PetscReal si;
PetscInt intensity;
int i;
PetscMPIInt rank;
char version[256];
#if !defined(PETSC_HAVE_THREADSAFETY)
PetscReal logthreshold;
#endif
#if defined(PETSC_USE_LOG)
PetscViewerFormat format;
PetscBool flg4 = PETSC_FALSE;
#endif
PetscFunctionBegin;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
#if !defined(PETSC_HAVE_THREADSAFETY)
/*
Setup the memory management; support for tracing malloc() usage
*/
ierr = PetscOptionsHasName(NULL,"-malloc_log",&flg3);CHKERRQ(ierr);
logthreshold = 0.0;
ierr = PetscOptionsGetReal(NULL,"-malloc_log_threshold",&logthreshold,&flg1);CHKERRQ(ierr);
if (flg1) flg3 = PETSC_TRUE;
#if defined(PETSC_USE_DEBUG)
ierr = PetscOptionsGetBool(NULL,"-malloc",&flg1,&flg2);CHKERRQ(ierr);
if ((!flg2 || flg1) && !petscsetmallocvisited) {
if (flg2 || !(PETSC_RUNNING_ON_VALGRIND)) {
/* turn off default -malloc if valgrind is being used */
ierr = PetscSetUseTrMalloc_Private();CHKERRQ(ierr);
}
}
#else
ierr = PetscOptionsGetBool(NULL,"-malloc_dump",&flg1,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,"-malloc",&flg2,NULL);CHKERRQ(ierr);
if (flg1 || flg2 || flg3) {ierr = PetscSetUseTrMalloc_Private();CHKERRQ(ierr);}
#endif
if (flg3) {
ierr = PetscMallocSetDumpLogThreshold((PetscLogDouble)logthreshold);CHKERRQ(ierr);
}
flg1 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-malloc_debug",&flg1,NULL);CHKERRQ(ierr);
if (flg1) {
ierr = PetscSetUseTrMalloc_Private();CHKERRQ(ierr);
ierr = PetscMallocDebug(PETSC_TRUE);CHKERRQ(ierr);
}
flg1 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-malloc_test",&flg1,NULL);CHKERRQ(ierr);
#if defined(PETSC_USE_DEBUG)
if (flg1 && !PETSC_RUNNING_ON_VALGRIND) {
ierr = PetscSetUseTrMalloc_Private();CHKERRQ(ierr);
ierr = PetscMallocSetDumpLog();CHKERRQ(ierr);
ierr = PetscMallocDebug(PETSC_TRUE);CHKERRQ(ierr);
}
#endif
flg1 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-malloc_info",&flg1,NULL);CHKERRQ(ierr);
if (!flg1) {
flg1 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-memory_view",&flg1,NULL);CHKERRQ(ierr);
}
if (flg1) {
ierr = PetscMemorySetGetMaximumUsage();CHKERRQ(ierr);
}
#endif
#if defined(PETSC_USE_LOG)
ierr = PetscOptionsHasName(NULL,"-objects_dump",&PetscObjectsLog);CHKERRQ(ierr);
#endif
/*
Set the display variable for graphics
*/
ierr = PetscSetDisplay();CHKERRQ(ierr);
/*
Print the PETSc version information
*/
ierr = PetscOptionsHasName(NULL,"-v",&flg1);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-version",&flg2);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-help",&flg3);CHKERRQ(ierr);
if (flg1 || flg2 || flg3) {
/*
Print "higher-level" package version message
*/
if (PetscExternalVersionFunction) {
ierr = (*PetscExternalVersionFunction)(comm);CHKERRQ(ierr);
}
ierr = PetscGetVersion(version,256);CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm,"--------------------------------------------\
------------------------------\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm,"%s\n",version);CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm,"%s",PETSC_AUTHOR_INFO);CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm,"See docs/changes/index.html for recent updates.\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm,"See docs/faq.html for problems.\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm,"See docs/manualpages/index.html for help. \n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm,"Libraries linked from %s\n",PETSC_LIB_DIR);CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm,"--------------------------------------------\
------------------------------\n");CHKERRQ(ierr);
}
/*
Print "higher-level" package help message
*/
if (flg3) {
if (PetscExternalHelpFunction) {
ierr = (*PetscExternalHelpFunction)(comm);CHKERRQ(ierr);
}
}
/*
Setup the error handling
*/
flg1 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-on_error_abort",&flg1,NULL);CHKERRQ(ierr);
if (flg1) {
ierr = MPI_Comm_set_errhandler(PETSC_COMM_WORLD,MPI_ERRORS_ARE_FATAL);CHKERRQ(ierr);
ierr = PetscPushErrorHandler(PetscAbortErrorHandler,0);CHKERRQ(ierr);
}
flg1 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-on_error_mpiabort",&flg1,NULL);CHKERRQ(ierr);
if (flg1) { ierr = PetscPushErrorHandler(PetscMPIAbortErrorHandler,0);CHKERRQ(ierr);}
flg1 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-mpi_return_on_error",&flg1,NULL);CHKERRQ(ierr);
if (flg1) {
ierr = MPI_Comm_set_errhandler(comm,MPI_ERRORS_RETURN);CHKERRQ(ierr);
}
flg1 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-no_signal_handler",&flg1,NULL);CHKERRQ(ierr);
if (!flg1) {ierr = PetscPushSignalHandler(PetscSignalHandlerDefault,(void*)0);CHKERRQ(ierr);}
flg1 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-fp_trap",&flg1,NULL);CHKERRQ(ierr);
if (flg1) {ierr = PetscSetFPTrap(PETSC_FP_TRAP_ON);CHKERRQ(ierr);}
ierr = PetscOptionsGetInt(NULL,"-check_pointer_intensity",&intensity,&flag);CHKERRQ(ierr);
if (flag) {ierr = PetscCheckPointerSetIntensity(intensity);CHKERRQ(ierr);}
/*
Setup debugger information
*/
ierr = PetscSetDefaultDebugger();CHKERRQ(ierr);
ierr = PetscOptionsGetString(NULL,"-on_error_attach_debugger",string,64,&flg1);CHKERRQ(ierr);
if (flg1) {
MPI_Errhandler err_handler;
ierr = PetscSetDebuggerFromString(string);CHKERRQ(ierr);
ierr = MPI_Comm_create_errhandler((MPI_Handler_function*)Petsc_MPI_DebuggerOnError,&err_handler);CHKERRQ(ierr);
ierr = MPI_Comm_set_errhandler(comm,err_handler);CHKERRQ(ierr);
ierr = PetscPushErrorHandler(PetscAttachDebuggerErrorHandler,0);CHKERRQ(ierr);
}
ierr = PetscOptionsGetString(NULL,"-debug_terminal",string,64,&flg1);CHKERRQ(ierr);
if (flg1) { ierr = PetscSetDebugTerminal(string);CHKERRQ(ierr); }
ierr = PetscOptionsGetString(NULL,"-start_in_debugger",string,64,&flg1);CHKERRQ(ierr);
ierr = PetscOptionsGetString(NULL,"-stop_for_debugger",string,64,&flg2);CHKERRQ(ierr);
if (flg1 || flg2) {
PetscMPIInt size;
PetscInt lsize,*nodes;
MPI_Errhandler err_handler;
/*
we have to make sure that all processors have opened
connections to all other processors, otherwise once the
debugger has stated it is likely to receive a SIGUSR1
and kill the program.
*/
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size > 2) {
PetscMPIInt dummy = 0;
MPI_Status status;
for (i=0; i<size; i++) {
if (rank != i) {
ierr = MPI_Send(&dummy,1,MPI_INT,i,109,PETSC_COMM_WORLD);CHKERRQ(ierr);
}
}
for (i=0; i<size; i++) {
if (rank != i) {
ierr = MPI_Recv(&dummy,1,MPI_INT,i,109,PETSC_COMM_WORLD,&status);CHKERRQ(ierr);
}
}
}
/* check if this processor node should be in debugger */
ierr = PetscMalloc1(size,&nodes);CHKERRQ(ierr);
lsize = size;
ierr = PetscOptionsGetIntArray(NULL,"-debugger_nodes",nodes,&lsize,&flag);CHKERRQ(ierr);
if (flag) {
for (i=0; i<lsize; i++) {
if (nodes[i] == rank) { flag = PETSC_FALSE; break; }
}
}
if (!flag) {
ierr = PetscSetDebuggerFromString(string);CHKERRQ(ierr);
ierr = PetscPushErrorHandler(PetscAbortErrorHandler,0);CHKERRQ(ierr);
if (flg1) {
ierr = PetscAttachDebugger();CHKERRQ(ierr);
} else {
ierr = PetscStopForDebugger();CHKERRQ(ierr);
}
ierr = MPI_Comm_create_errhandler((MPI_Handler_function*)Petsc_MPI_AbortOnError,&err_handler);CHKERRQ(ierr);
ierr = MPI_Comm_set_errhandler(comm,err_handler);CHKERRQ(ierr);
}
ierr = PetscFree(nodes);CHKERRQ(ierr);
}
ierr = PetscOptionsGetString(NULL,"-on_error_emacs",emacsmachinename,128,&flg1);CHKERRQ(ierr);
if (flg1 && !rank) {ierr = PetscPushErrorHandler(PetscEmacsClientErrorHandler,emacsmachinename);CHKERRQ(ierr);}
/*
Setup profiling and logging
*/
#if defined(PETSC_USE_INFO)
{
char logname[PETSC_MAX_PATH_LEN]; logname[0] = 0;
ierr = PetscOptionsGetString(NULL,"-info",logname,250,&flg1);CHKERRQ(ierr);
if (flg1 && logname[0]) {
ierr = PetscInfoAllow(PETSC_TRUE,logname);CHKERRQ(ierr);
} else if (flg1) {
ierr = PetscInfoAllow(PETSC_TRUE,NULL);CHKERRQ(ierr);
}
}
#endif
#if defined(PETSC_USE_LOG)
mname[0] = 0;
ierr = PetscOptionsGetString(NULL,"-history",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
if (flg1) {
if (mname[0]) {
ierr = PetscOpenHistoryFile(mname,&petsc_history);CHKERRQ(ierr);
} else {
ierr = PetscOpenHistoryFile(NULL,&petsc_history);CHKERRQ(ierr);
}
}
#if defined(PETSC_HAVE_MPE)
flg1 = PETSC_FALSE;
ierr = PetscOptionsHasName(NULL,"-log_mpe",&flg1);CHKERRQ(ierr);
if (flg1) {ierr = PetscLogMPEBegin();CHKERRQ(ierr);}
#endif
flg1 = PETSC_FALSE;
flg3 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-log_all",&flg1,NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-log_summary",&flg3);CHKERRQ(ierr);
if (flg1) { ierr = PetscLogAllBegin();CHKERRQ(ierr); }
else if (flg3) { ierr = PetscLogDefaultBegin();CHKERRQ(ierr);}
ierr = PetscOptionsGetString(NULL,"-log_trace",mname,250,&flg1);CHKERRQ(ierr);
if (flg1) {
char name[PETSC_MAX_PATH_LEN],fname[PETSC_MAX_PATH_LEN];
FILE *file;
if (mname[0]) {
sprintf(name,"%s.%d",mname,rank);
ierr = PetscFixFilename(name,fname);CHKERRQ(ierr);
file = fopen(fname,"w");
if (!file) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to open trace file: %s",fname);
} else file = PETSC_STDOUT;
ierr = PetscLogTraceBegin(file);CHKERRQ(ierr);
}
ierr = PetscOptionsGetViewer(PETSC_COMM_WORLD,NULL,"-log_view",NULL,&format,&flg4);CHKERRQ(ierr);
if (flg4) {
if (format == PETSC_VIEWER_ASCII_XML){
ierr = PetscLogNestedBegin();CHKERRQ(ierr);
} else {
ierr = PetscLogDefaultBegin();CHKERRQ(ierr);
}
}
#endif
ierr = PetscOptionsGetBool(NULL,"-saws_options",&PetscOptionsPublish,NULL);CHKERRQ(ierr);
#if defined(PETSC_HAVE_CUDA)
ierr = PetscOptionsHasName(NULL,"-cuda_show_devices",&flg1);CHKERRQ(ierr);
if (flg1) {
struct cudaDeviceProp prop;
int devCount;
int device;
cudaError_t err = cudaSuccess;
err = cudaGetDeviceCount(&devCount);
if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaGetDeviceCount %s",cudaGetErrorString(err));
for (device = 0; device < devCount; ++device) {
err = cudaGetDeviceProperties(&prop, device);
if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaGetDeviceProperties %s",cudaGetErrorString(err));
ierr = PetscPrintf(PETSC_COMM_WORLD, "CUDA device %d: %s\n", device, prop.name);CHKERRQ(ierr);
}
}
{
int size;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size>1) {
int devCount, device, rank;
cudaError_t err = cudaSuccess;
/* check to see if we force multiple ranks to hit the same GPU */
ierr = PetscOptionsGetInt(NULL,"-cuda_set_device", &device, &flg1);CHKERRQ(ierr);
if (flg1) {
err = cudaSetDevice(device);
if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaSetDevice %s",cudaGetErrorString(err));
} else {
/* we're not using the same GPU on multiple MPI threads. So try to allocated different GPUs to different processes */
/* First get the device count */
err = cudaGetDeviceCount(&devCount);
if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaGetDeviceCount %s",cudaGetErrorString(err));
/* next determine the rank and then set the device via a mod */
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
device = rank % devCount;
err = cudaSetDevice(device);
if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaSetDevice %s",cudaGetErrorString(err));
}
/* set the device flags so that it can map host memory ... do NOT throw exception on err!=cudaSuccess
multiple devices may try to set the flags on the same device. So long as one of them succeeds, things
are ok. */
err = cudaSetDeviceFlags(cudaDeviceMapHost);
if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaSetDeviceFlags %s",cudaGetErrorString(err));
} else {
int device;
cudaError_t err = cudaSuccess;
/* the code below works for serial GPU simulations */
ierr = PetscOptionsGetInt(NULL,"-cuda_set_device", &device, &flg1);CHKERRQ(ierr);
if (flg1) {
err = cudaSetDevice(device);
if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaSetDevice %s",cudaGetErrorString(err));
}
/* set the device flags so that it can map host memory ... here, we error check. */
err = cudaSetDeviceFlags(cudaDeviceMapHost);
if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaSetDeviceFlags %s",cudaGetErrorString(err));
}
}
#endif
/*
Print basic help message
*/
ierr = PetscOptionsHasName(NULL,"-help",&flg1);CHKERRQ(ierr);
if (flg1) {
ierr = (*PetscHelpPrintf)(comm,"Options for all PETSc programs:\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -help: prints help method for each option\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -on_error_abort: cause an abort when an error is detected. Useful \n ");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," only when run in the debugger\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -on_error_attach_debugger [gdb,dbx,xxgdb,ups,noxterm]\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," start the debugger in new xterm\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," unless noxterm is given\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -start_in_debugger [gdb,dbx,xxgdb,ups,noxterm]\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," start all processes in the debugger\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -on_error_emacs <machinename>\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," emacs jumps to error file\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -debugger_nodes [n1,n2,..] Nodes to start in debugger\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -debugger_pause [m] : delay (in seconds) to attach debugger\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -stop_for_debugger : prints message on how to attach debugger manually\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," waits the delay for you to attach\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -display display: Location where X window graphics and debuggers are displayed\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -no_signal_handler: do not trap error signals\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -mpi_return_on_error: MPI returns error code, rather than abort on internal error\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -fp_trap: stop on floating point exceptions\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," note on IBM RS6000 this slows run greatly\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -malloc_dump <optional filename>: dump list of unfreed memory at conclusion\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -malloc: use our error checking malloc\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -malloc no: don't use error checking malloc\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -malloc_info: prints total memory usage\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -malloc_log: keeps log of all memory allocations\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -malloc_debug: enables extended checking for memory corruption\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -options_table: dump list of options inputted\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -options_left: dump list of unused options\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -options_left no: don't dump list of unused options\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -tmp tmpdir: alternative /tmp directory\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -shared_tmp: tmp directory is shared by all processors\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -not_shared_tmp: each processor has separate tmp directory\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -memory_view: print memory usage at end of run\n");CHKERRQ(ierr);
#if defined(PETSC_USE_LOG)
ierr = (*PetscHelpPrintf)(comm," -get_total_flops: total flops over all processors\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -log[_summary _summary_python]: logging objects and events\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -log_trace [filename]: prints trace of all PETSc calls\n");CHKERRQ(ierr);
#if defined(PETSC_HAVE_MPE)
ierr = (*PetscHelpPrintf)(comm," -log_mpe: Also create logfile viewable through Jumpshot\n");CHKERRQ(ierr);
#endif
ierr = (*PetscHelpPrintf)(comm," -info <optional filename>: print informative messages about the calculations\n");CHKERRQ(ierr);
#endif
ierr = (*PetscHelpPrintf)(comm," -v: prints PETSc version number and release date\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -options_file <file>: reads options from file\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm," -petsc_sleep n: sleeps n seconds before running program\n");CHKERRQ(ierr);
ierr = (*PetscHelpPrintf)(comm,"-----------------------------------------------\n");CHKERRQ(ierr);
}
#if defined(PETSC_HAVE_POPEN)
{
char machine[128];
ierr = PetscOptionsGetString(NULL,"-popen_machine",machine,128,&flg1);CHKERRQ(ierr);
if (flg1) {
ierr = PetscPOpenSetMachine(machine);CHKERRQ(ierr);
}
}
#endif
ierr = PetscOptionsGetReal(NULL,"-petsc_sleep",&si,&flg1);CHKERRQ(ierr);
if (flg1) {
ierr = PetscSleep(si);CHKERRQ(ierr);
}
ierr = PetscOptionsGetString(NULL,"-info_exclude",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
if (flg1) {
ierr = PetscStrstr(mname,"null",&f);CHKERRQ(ierr);
if (f) {
ierr = PetscInfoDeactivateClass(0);CHKERRQ(ierr);
}
}
#if defined(PETSC_HAVE_CUSP) || defined(PETSC_HAVE_VIENNACL)
ierr = PetscOptionsHasName(NULL,"-log_summary",&flg3);CHKERRQ(ierr);
if (!flg3) {
ierr = PetscOptionsHasName(NULL,"-log_view",&flg3);CHKERRQ(ierr);
}
#endif
#if defined(PETSC_HAVE_CUSP)
ierr = PetscOptionsGetBool(NULL,"-cusp_synchronize",&flg3,NULL);CHKERRQ(ierr);
PetscCUSPSynchronize = flg3;
#elif defined(PETSC_HAVE_VIENNACL)
ierr = PetscOptionsGetBool(NULL,"-viennacl_synchronize",&flg3,NULL);CHKERRQ(ierr);
PetscViennaCLSynchronize = flg3;
#endif
PetscFunctionReturn(0);
}
PETSC_EXTERN void PETSC_STDCALL petscsleep_(PetscReal *s, int *__ierr ){
*__ierr = PetscSleep(*s);
}
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);
}
