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