PetscErrorCode SNESConvergedDefault_VI(SNES snes,PetscInt it,PetscReal xnorm,PetscReal gradnorm,PetscReal fnorm,SNESConvergedReason *reason,void *dummy)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
PetscValidPointer(reason,6);
*reason = SNES_CONVERGED_ITERATING;
if (!it) {
/* set parameter for default relative tolerance convergence test */
snes->ttol = fnorm*snes->rtol;
}
if (fnorm != fnorm) {
ierr = PetscInfo(snes,"Failed to converged, function norm is NaN\n");CHKERRQ(ierr);
*reason = SNES_DIVERGED_FNORM_NAN;
} else if (fnorm < snes->abstol) {
ierr = PetscInfo2(snes,"Converged due to function norm %g < %g\n",(double)fnorm,(double)snes->abstol);CHKERRQ(ierr);
*reason = SNES_CONVERGED_FNORM_ABS;
} else if (snes->nfuncs >= snes->max_funcs) {
ierr = PetscInfo2(snes,"Exceeded maximum number of function evaluations: %D > %D\n",snes->nfuncs,snes->max_funcs);CHKERRQ(ierr);
*reason = SNES_DIVERGED_FUNCTION_COUNT;
}
if (it && !*reason) {
if (fnorm < snes->ttol) {
ierr = PetscInfo2(snes,"Converged due to function norm %g < %g (relative tolerance)\n",(double)fnorm,(double)snes->ttol);CHKERRQ(ierr);
*reason = SNES_CONVERGED_FNORM_RELATIVE;
}
}
PetscFunctionReturn(0);
}
static PetscErrorCode TSAdaptChoose_Basic(TSAdapt adapt,TS ts,PetscReal h,PetscInt *next_sc,PetscReal *next_h,PetscBool *accept,PetscReal *wlte)
{
TSAdapt_Basic *basic = (TSAdapt_Basic*)adapt->data;
PetscInt order = PETSC_DECIDE;
PetscReal enorm = -1;
PetscReal safety = basic->safety;
PetscReal hfac_lte,h_lte;
PetscErrorCode ierr;
PetscFunctionBegin;
*next_sc = 0; /* Reuse the same order scheme */
if (ts->ops->evaluatewlte) {
ierr = TSEvaluateWLTE(ts,adapt->wnormtype,&order,&enorm);CHKERRQ(ierr);
if (enorm >= 0 && order < 1) SETERRQ1(PetscObjectComm((PetscObject)adapt),PETSC_ERR_ARG_OUTOFRANGE,"Computed error order %D must be positive",order);
} else if (ts->ops->evaluatestep) {
if (adapt->candidates.n < 1) SETERRQ(PetscObjectComm((PetscObject)adapt),PETSC_ERR_ARG_WRONGSTATE,"No candidate has been registered");
if (!adapt->candidates.inuse_set) SETERRQ1(PetscObjectComm((PetscObject)adapt),PETSC_ERR_ARG_WRONGSTATE,"The current in-use scheme is not among the %D candidates",adapt->candidates.n);
if (!basic->Y) {ierr = VecDuplicate(ts->vec_sol,&basic->Y);CHKERRQ(ierr);}
order = adapt->candidates.order[0];
ierr = TSEvaluateStep(ts,order-1,basic->Y,NULL);CHKERRQ(ierr);
ierr = TSErrorWeightedNorm(ts,ts->vec_sol,basic->Y,adapt->wnormtype,&enorm);CHKERRQ(ierr);
}
if (enorm < 0) {
*accept = PETSC_TRUE;
*next_h = h; /* Reuse the old step */
*wlte = -1; /* Weighted local truncation error was not evaluated */
PetscFunctionReturn(0);
}
/* Determine whether the step is accepted of rejected */
if (enorm > 1) {
if (!*accept) safety *= basic->reject_safety; /* The last attempt also failed, shorten more aggressively */
if (h < (1 + PETSC_SQRT_MACHINE_EPSILON)*adapt->dt_min) {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting because step size %g is at minimum\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
} else if (basic->always_accept) {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting step of size %g because always_accept is set\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
} else {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, rejecting step of size %g\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_FALSE;
}
} else {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting step of size %g\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
}
/* The optimal new step based purely on local truncation error for this step. */
if (enorm > 0)
hfac_lte = safety * PetscPowReal(enorm,((PetscReal)-1)/order);
else
hfac_lte = safety * PETSC_INFINITY;
h_lte = h * PetscClipInterval(hfac_lte,basic->clip[0],basic->clip[1]);
*next_h = PetscClipInterval(h_lte,adapt->dt_min,adapt->dt_max);
*wlte = enorm;
PetscFunctionReturn(0);
}
PetscErrorCode PCMGMCycle_Private(PC pc,PC_MG_Levels **mglevelsin,PCRichardsonConvergedReason *reason)
{
PC_MG *mg = (PC_MG*)pc->data;
PC_MG_Levels *mgc,*mglevels = *mglevelsin;
PetscErrorCode ierr;
PetscInt cycles = (mglevels->level == 1) ? 1 : (PetscInt) mglevels->cycles;
PC subpc;
PCFailedReason pcreason;
PetscFunctionBegin;
if (mglevels->eventsmoothsolve) {ierr = PetscLogEventBegin(mglevels->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSolve(mglevels->smoothd,mglevels->b,mglevels->x);CHKERRQ(ierr); /* pre-smooth */
ierr = KSPGetPC(mglevels->smoothd,&subpc);CHKERRQ(ierr);
ierr = PCGetSetUpFailedReason(subpc,&pcreason);CHKERRQ(ierr);
if (pcreason) {
pc->failedreason = PC_SUBPC_ERROR;
}
if (mglevels->eventsmoothsolve) {ierr = PetscLogEventEnd(mglevels->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
if (mglevels->level) { /* not the coarsest grid */
if (mglevels->eventresidual) {ierr = PetscLogEventBegin(mglevels->eventresidual,0,0,0,0);CHKERRQ(ierr);}
ierr = (*mglevels->residual)(mglevels->A,mglevels->b,mglevels->x,mglevels->r);CHKERRQ(ierr);
if (mglevels->eventresidual) {ierr = PetscLogEventEnd(mglevels->eventresidual,0,0,0,0);CHKERRQ(ierr);}
/* if on finest level and have convergence criteria set */
if (mglevels->level == mglevels->levels-1 && mg->ttol && reason) {
PetscReal rnorm;
ierr = VecNorm(mglevels->r,NORM_2,&rnorm);CHKERRQ(ierr);
if (rnorm <= mg->ttol) {
if (rnorm < mg->abstol) {
*reason = PCRICHARDSON_CONVERGED_ATOL;
ierr = PetscInfo2(pc,"Linear solver has converged. Residual norm %g is less than absolute tolerance %g\n",(double)rnorm,(double)mg->abstol);CHKERRQ(ierr);
} else {
*reason = PCRICHARDSON_CONVERGED_RTOL;
ierr = PetscInfo2(pc,"Linear solver has converged. Residual norm %g is less than relative tolerance times initial residual norm %g\n",(double)rnorm,(double)mg->ttol);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
}
mgc = *(mglevelsin - 1);
if (mglevels->eventinterprestrict) {ierr = PetscLogEventBegin(mglevels->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
ierr = MatRestrict(mglevels->restrct,mglevels->r,mgc->b);CHKERRQ(ierr);
if (mglevels->eventinterprestrict) {ierr = PetscLogEventEnd(mglevels->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
ierr = VecSet(mgc->x,0.0);CHKERRQ(ierr);
while (cycles--) {
ierr = PCMGMCycle_Private(pc,mglevelsin-1,reason);CHKERRQ(ierr);
}
if (mglevels->eventinterprestrict) {ierr = PetscLogEventBegin(mglevels->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
ierr = MatInterpolateAdd(mglevels->interpolate,mgc->x,mglevels->x,mglevels->x);CHKERRQ(ierr);
if (mglevels->eventinterprestrict) {ierr = PetscLogEventEnd(mglevels->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
if (mglevels->eventsmoothsolve) {ierr = PetscLogEventBegin(mglevels->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSolve(mglevels->smoothu,mglevels->b,mglevels->x);CHKERRQ(ierr); /* post smooth */
if (mglevels->eventsmoothsolve) {ierr = PetscLogEventEnd(mglevels->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
}
PetscFunctionReturn(0);
}
/*@C
PetscDrawSetSave - Saves images produced in a PetscDraw into a file
Collective on PetscDraw
Input Parameter:
+ draw - the graphics context
. filename - name of the file, if .ext then uses name of draw object plus .ext using .ext to determine the image type
- movieext - if not NULL, produces a movie of all the images
Options Database Command:
+ -draw_save <filename> - filename could be name.ext or .ext (where .ext determines the type of graphics file to save, for example .png)
. -draw_save_movie <.ext> - saves a movie to filename.ext
. -draw_save_final_image [optional filename] - saves the final image displayed in a window
- -draw_save_single_file - saves each new image in the same file, normally each new image is saved in a new file with filename/filename_%d.ext
Level: intermediate
Concepts: X windows^graphics
Notes: You should call this BEFORE creating your image and calling PetscDrawSave().
The supported image types are .png, .gif, .jpg, and .ppm (PETSc chooses the default in that order).
Support for .png images requires configure --with-libpng.
Support for .gif images requires configure --with-giflib.
Support for .jpg images requires configure --with-libjpeg.
Support for .ppm images is built-in. The PPM format has no compression (640x480 pixels ~ 900 KiB).
The ffmpeg utility must be in your path to make the movie.
.seealso: PetscDrawSetFromOptions(), PetscDrawCreate(), PetscDrawDestroy(), PetscDrawSetSaveFinalImage()
@*/
PetscErrorCode PetscDrawSetSave(PetscDraw draw,const char filename[],const char movieext[])
{
const char *savename = NULL;
const char *imageext = NULL;
char buf[PETSC_MAX_PATH_LEN];
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(draw,PETSC_DRAW_CLASSID,1);
if (filename) PetscValidCharPointer(filename,2);
if (movieext) PetscValidCharPointer(movieext,2);
/* determine save filename and image extension */
if (filename && filename[0]) {
ierr = PetscStrchr(filename,'.',(char **)&imageext);CHKERRQ(ierr);
if (!imageext) savename = filename;
else if (imageext != filename) {
size_t l1 = 0,l2 = 0;
ierr = PetscStrlen(filename,&l1);CHKERRQ(ierr);
ierr = PetscStrlen(imageext,&l2);CHKERRQ(ierr);
ierr = PetscStrncpy(buf,filename,l1-l2+1);CHKERRQ(ierr);
savename = buf;
}
}
if (!savename) {ierr = PetscObjectGetName((PetscObject)draw,&savename);CHKERRQ(ierr);}
ierr = PetscDrawImageCheckFormat(&imageext);CHKERRQ(ierr);
if (movieext) {ierr = PetscDrawMovieCheckFormat(&movieext);CHKERRQ(ierr);}
if (movieext) draw->savesinglefile = PETSC_FALSE; /* otherwise we cannot generage movies */
if (draw->savesinglefile) {
ierr = PetscInfo2(NULL,"Will save image to file %s%s\n",savename,imageext);CHKERRQ(ierr);
} else {
ierr = PetscInfo3(NULL,"Will save images to file %s/%s_%%d%s\n",savename,savename,imageext);CHKERRQ(ierr);
}
if (movieext) {
ierr = PetscInfo2(NULL,"Will save movie to file %s%s\n",savename,movieext);CHKERRQ(ierr);
}
draw->savefilecount = 0;
ierr = PetscFree(draw->savefilename);CHKERRQ(ierr);
ierr = PetscFree(draw->saveimageext);CHKERRQ(ierr);
ierr = PetscFree(draw->savemovieext);CHKERRQ(ierr);
ierr = PetscStrallocpy(savename,&draw->savefilename);CHKERRQ(ierr);
ierr = PetscStrallocpy(imageext,&draw->saveimageext);CHKERRQ(ierr);
ierr = PetscStrallocpy(movieext,&draw->savemovieext);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
PetscHMPISpawn - Initialize additional processes to be used as "worker" processes. This is not generally
called by users. One should use -hmpi_spawn_size <n> to indicate that you wish to have n-1 new MPI
processes spawned for each current process.
Not Collective (could make collective on MPI_COMM_WORLD, generate one huge comm and then split it up)
Input Parameter:
. nodesize - size of each compute node that will share processors
Options Database:
. -hmpi_spawn_size nodesize
Notes: This is only supported on systems with an MPI 2 implementation that includes the MPI_Comm_Spawn() routine.
$ Comparison of two approaches for HMPI usage (MPI started with N processes)
$
$ -hmpi_spawn_size <n> requires MPI 2, results in n*N total processes with N directly used by application code
$ and n-1 worker processes (used by PETSc) for each application node.
$ You MUST launch MPI so that only ONE MPI process is created for each hardware node.
$
$ -hmpi_merge_size <n> results in N total processes, N/n used by the application code and the rest worker processes
$ (used by PETSc)
$ You MUST launch MPI so that n MPI processes are created for each hardware node.
$
$ petscmpiexec -n 2 ./ex1 -hmpi_spawn_size 3 gives 2 application nodes (and 4 PETSc worker nodes)
$ petscmpiexec -n 6 ./ex1 -hmpi_merge_size 3 gives the SAME 2 application nodes and 4 PETSc worker nodes
$ This is what would use if each of the computers hardware nodes had 3 CPUs.
$
$ These are intended to be used in conjunction with USER HMPI code. The user will have 1 process per
$ computer (hardware) node (where the computer node has p cpus), the user's code will use threads to fully
$ utilize all the CPUs on the node. The PETSc code will have p processes to fully use the compute node for
$ PETSc calculations. The user THREADS and PETSc PROCESSES will NEVER run at the same time so the p CPUs
$ are always working on p task, never more than p.
$
$ See PCHMPI for a PETSc preconditioner that can use this functionality
$
For both PetscHMPISpawn() and PetscHMPIMerge() PETSC_COMM_WORLD consists of one process per "node", PETSC_COMM_LOCAL_WORLD
consists of all the processes in a "node."
In both cases the user's code is running ONLY on PETSC_COMM_WORLD (that was newly generated by running this command).
Level: developer
Concepts: HMPI
.seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscHMPIFinalize(), PetscInitialize(), PetscHMPIMerge(), PetscHMPIRun()
@*/
PetscErrorCode PetscHMPISpawn(PetscMPIInt nodesize)
{
PetscErrorCode ierr;
PetscMPIInt size;
MPI_Comm parent,children;
PetscFunctionBegin;
ierr = MPI_Comm_get_parent(&parent);CHKERRQ(ierr);
if (parent == MPI_COMM_NULL) { /* the original processes started by user */
char programname[PETSC_MAX_PATH_LEN];
char **argv;
ierr = PetscGetProgramName(programname,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
ierr = PetscGetArguments(&argv);CHKERRQ(ierr);
ierr = MPI_Comm_spawn(programname,argv,nodesize-1,MPI_INFO_NULL,0,PETSC_COMM_SELF,&children,MPI_ERRCODES_IGNORE);CHKERRQ(ierr);
ierr = PetscFreeArguments(argv);CHKERRQ(ierr);
ierr = MPI_Intercomm_merge(children,0,&PETSC_COMM_LOCAL_WORLD);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = PetscInfo2(0,"PETSc HMPI successfully spawned: number of nodes = %d node size = %d\n",size,nodesize);CHKERRQ(ierr);
saved_PETSC_COMM_WORLD = PETSC_COMM_WORLD;
} else { /* worker nodes that get spawned */
ierr = MPI_Intercomm_merge(parent,1,&PETSC_COMM_LOCAL_WORLD);CHKERRQ(ierr);
ierr = PetscHMPIHandle(PETSC_COMM_LOCAL_WORLD);CHKERRQ(ierr);
PetscHMPIWorker = PETSC_TRUE; /* so that PetscHMPIFinalize() will not attempt a broadcast from this process */
PetscEnd(); /* cannot continue into user code */
}
PetscFunctionReturn(0);
}
/*@C
KSPMonitorSAWs - monitor solution using SAWs
Logically Collective on KSP
Input Parameters:
+ ksp - iterative context
. n - iteration number
. rnorm - 2-norm (preconditioned) residual value (may be estimated).
- ctx - PetscViewer of type SAWs
Level: advanced
.keywords: KSP, CG, monitor, SAWs, singular values
.seealso: KSPMonitorSingularValue(), KSPComputeExtremeSingularValues(), PetscViewerSAWsOpen()
@*/
PetscErrorCode KSPMonitorSAWs(KSP ksp,PetscInt n,PetscReal rnorm,void *ctx)
{
PetscErrorCode ierr;
KSPMonitor_SAWs *mon = (KSPMonitor_SAWs*)ctx;
PetscReal emax,emin;
PetscMPIInt rank;
PetscFunctionBegin;
PetscValidHeaderSpecific(ksp,KSP_CLASSID,1);
ierr = KSPComputeExtremeSingularValues(ksp,&emax,&emin);CHKERRQ(ierr);
ierr = PetscFree2(mon->eigr,mon->eigi);CHKERRQ(ierr);
ierr = PetscMalloc2(n,&mon->eigr,n,&mon->eigi);CHKERRQ(ierr);
if (n) {
ierr = KSPComputeEigenvalues(ksp,n,mon->eigr,mon->eigi,&mon->neigs);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
if (!rank) {
SAWs_Delete("/PETSc/ksp_monitor_saws/eigr");
SAWs_Delete("/PETSc/ksp_monitor_saws/eigi");
PetscStackCallSAWs(SAWs_Register,("/PETSc/ksp_monitor_saws/rnorm",&ksp->rnorm,1,SAWs_READ,SAWs_DOUBLE));
PetscStackCallSAWs(SAWs_Register,("/PETSc/ksp_monitor_saws/neigs",&mon->neigs,1,SAWs_READ,SAWs_INT));
if (mon->neigs > 0) {
PetscStackCallSAWs(SAWs_Register,("/PETSc/ksp_monitor_saws/eigr",mon->eigr,mon->neigs,SAWs_READ,SAWs_DOUBLE));
PetscStackCallSAWs(SAWs_Register,("/PETSc/ksp_monitor_saws/eigi",mon->eigi,mon->neigs,SAWs_READ,SAWs_DOUBLE));
}
ierr = PetscInfo2(ksp,"KSP extreme singular values min=%g max=%g\n",(double)emin,(double)emax);CHKERRQ(ierr);
ierr = PetscSAWsBlock();CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
EXTERN_C_END
#undef __FUNCT__
#define __FUNCT__ "PetscViewerSocketSetConnection"
/*@C
PetscViewerSocketSetConnection - Sets the machine and port that a PETSc socket
viewer is to use
Collective on PetscViewer
Input Parameters:
+ v - viewer to connect
. machine - host to connect to, use PETSC_NULL for the local machine,use "server" to passively wait for
a connection from elsewhere
- port - the port on the machine one is connecting to, use PETSC_DEFAULT for default
Level: advanced
.seealso: PetscViewerSocketOpen()
@*/
PetscErrorCode PETSC_DLLEXPORT PetscViewerSocketSetConnection(PetscViewer v,const char machine[],PetscInt port)
{
PetscErrorCode ierr;
PetscMPIInt rank;
char mach[256];
PetscTruth tflg;
PetscViewer_Socket *vmatlab = (PetscViewer_Socket *)v->data;
PetscFunctionBegin;
if (port <= 0) {
char portn[16];
ierr = PetscOptionsGetenv(((PetscObject)v)->comm,"PETSC_VIEWER_SOCKET_PORT",portn,16,&tflg);CHKERRQ(ierr);
if (tflg) {
ierr = PetscOptionsAtoi(portn,&port);CHKERRQ(ierr);
} else {
port = PETSCSOCKETDEFAULTPORT;
}
}
if (!machine) {
ierr = PetscOptionsGetenv(((PetscObject)v)->comm,"PETSC_VIEWER_SOCKET_MACHINE",mach,256,&tflg);CHKERRQ(ierr);
if (!tflg) {
ierr = PetscGetHostName(mach,256);CHKERRQ(ierr);
}
} else {
ierr = PetscStrncpy(mach,machine,256);CHKERRQ(ierr);
}
ierr = MPI_Comm_rank(((PetscObject)v)->comm,&rank);CHKERRQ(ierr);
if (!rank) {
ierr = PetscStrcmp(mach,"server",&tflg);CHKERRQ(ierr);
if (tflg) {
ierr = PetscInfo1(v,"Waiting for connection from socket process on port %D\n",port);CHKERRQ(ierr);
ierr = SOCKAnswer_Private((int)port,&vmatlab->port);CHKERRQ(ierr);
} else {
ierr = PetscInfo2(v,"Connecting to socket process on port %D machine %s\n",port,mach);CHKERRQ(ierr);
ierr = PetscOpenSocket(mach,(int)port,&vmatlab->port);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
PetscErrorCode BSSCR_KSPConverged(KSP ksp,PetscInt n,PetscReal rnorm,KSPConvergedReason *reason,void *cctx)
{
PetscErrorCode ierr;
#if(PETSC_VERSION_MAJOR == 3)
BSSCR_KSPConverged_Ctx *ctx = (BSSCR_KSPConverged_Ctx *)cctx;
KSP_BSSCR *bsscr = ctx->bsscr;
#else
KSP_BSSCR *bsscr = (KSP_BSSCR*)cctx;
#endif
PetscFunctionBegin;
#if ( (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >=5 ) )
ierr = KSPConvergedDefault(ksp,n,rnorm,reason,ctx->ctx);CHKERRQ(ierr);
#endif
#if ( (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR <=4 ) )
ierr = KSPDefaultConverged(ksp,n,rnorm,reason,ctx->ctx);CHKERRQ(ierr);
#endif
#if ( PETSC_VERSION_MAJOR < 3)
ierr = KSPDefaultConverged(ksp,n,rnorm,reason,cctx);CHKERRQ(ierr);
#endif
if (*reason) {
ierr = PetscInfo2(ksp,"default convergence test KSP iterations=%D, rnorm=%G\n",n,rnorm);CHKERRQ(ierr);
}
if(ksp->its < bsscr->min_it){
ksp->reason = KSP_CONVERGED_ITERATING;
}
PetscFunctionReturn(0);
}
/*@
MatMFFDCheckPositivity - Checks that all entries in U + h*a are positive or
zero, decreases h until this is satisfied.
Logically Collective on Vec
Input Parameters:
+ U - base vector that is added to
. a - vector that is added
. h - scaling factor on a
- dummy - context variable (unused)
Options Database Keys:
. -mat_mffd_check_positivity
Level: advanced
Notes: This is rarely used directly, rather it is passed as an argument to
MatMFFDSetCheckh()
.seealso: MatMFFDSetCheckh()
@*/
PetscErrorCode MatMFFDCheckPositivity(void *dummy,Vec U,Vec a,PetscScalar *h)
{
PetscReal val, minval;
PetscScalar *u_vec, *a_vec;
PetscErrorCode ierr;
PetscInt i,n;
MPI_Comm comm;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)U,&comm);CHKERRQ(ierr);
ierr = VecGetArray(U,&u_vec);CHKERRQ(ierr);
ierr = VecGetArray(a,&a_vec);CHKERRQ(ierr);
ierr = VecGetLocalSize(U,&n);CHKERRQ(ierr);
minval = PetscAbsScalar(*h*1.01);
for (i=0; i<n; i++) {
if (PetscRealPart(u_vec[i] + *h*a_vec[i]) <= 0.0) {
val = PetscAbsScalar(u_vec[i]/a_vec[i]);
if (val < minval) minval = val;
}
}
ierr = VecRestoreArray(U,&u_vec);CHKERRQ(ierr);
ierr = VecRestoreArray(a,&a_vec);CHKERRQ(ierr);
ierr = MPI_Allreduce(&minval,&val,1,MPIU_REAL,MPIU_MIN,comm);CHKERRQ(ierr);
if (val <= PetscAbsScalar(*h)) {
ierr = PetscInfo2(U,"Scaling back h from %G to %G\n",PetscRealPart(*h),.99*val);CHKERRQ(ierr);
if (PetscRealPart(*h) > 0.0) *h = 0.99*val;
else *h = -0.99*val;
}
PetscFunctionReturn(0);
}
PetscErrorCode SeqCRL_create_crl(Mat A)
{
Mat_SeqAIJ *a = (Mat_SeqAIJ *)(A)->data;
Mat_CRL *crl = (Mat_CRL*) A->spptr;
PetscInt m = A->rmap->n; /* Number of rows in the matrix. */
PetscInt *aj = a->j; /* From the CSR representation; points to the beginning of each row. */
PetscInt i, j,rmax = a->rmax,*icols, *ilen = a->ilen;
MatScalar *aa = a->a;
PetscScalar *acols;
PetscErrorCode ierr;
PetscFunctionBegin;
crl->nz = a->nz;
crl->m = A->rmap->n;
crl->rmax = rmax;
ierr = PetscFree2(crl->acols,crl->icols);CHKERRQ(ierr);
ierr = PetscMalloc2(rmax*m,PetscScalar,&crl->acols,rmax*m,PetscInt,&crl->icols);CHKERRQ(ierr);
acols = crl->acols;
icols = crl->icols;
for (i=0; i<m; i++) {
for (j=0; j<ilen[i]; j++) {
acols[j*m+i] = *aa++;
icols[j*m+i] = *aj++;
}
for (;j<rmax; j++) { /* empty column entries */
acols[j*m+i] = 0.0;
icols[j*m+i] = (j) ? icols[(j-1)*m+i] : 0; /* handle case where row is EMPTY */
}
}
ierr = PetscInfo2(A,"Percentage of 0's introduced for vectorized multiply %G. Rmax= %D\n",1.0-((double)a->nz)/((double)(rmax*m)),rmax);
PetscFunctionReturn(0);
}
/* @ TaoApply_LineSearch - This routine takes step length of 1.0.
Input Parameters:
+ tao - TAO_SOLVER context
. X - current iterate (on output X contains new iterate, X + step*S)
. S - search direction
. f - objective function evaluated at X
. G - gradient evaluated at X
. W - work vector
. gdx - inner product of gradient and the direction of the first linear manifold being searched
- step - initial estimate of step length
Output parameters:
+ f - objective function evaluated at new iterate, X + step*S
. G - gradient evaluated at new iterate, X + step*S
. X - new iterate
- step - final step length
Info is set to 0.
@ */
static int TaoApply_UnitStep(TAO_SOLVER tao,TaoVec* X,TaoVec* G,TaoVec* S,TaoVec* W,double *f, double *f_full,
double *step,TaoInt *info2,void*ctx)
{
int info;
double fnew;
TaoVec *XL,*XU;
TaoFunctionBegin;
tao->new_search=TAO_TRUE;
info = W->CopyFrom(X); CHKERRQ(info);
info = W->Axpy(*step,S);CHKERRQ(info);
info = TaoGetVariableBounds(tao,&XL,&XU); CHKERRQ(info);
if (XL && XU){
info = W->Median(XL,W,XU);CHKERRQ(info);
}
info = TaoComputeMeritFunctionGradient(tao,W,&fnew,G); CHKERRQ(info);
info = X->CopyFrom(W); CHKERRQ(info);
info = PetscInfo1(tao,"Tao Apply Unit Step: %4.4e\n",*step);
CHKERRQ(info);
if (*f<fnew){
info = PetscInfo2(tao,"Tao Apply Unit Step, FINCREASE: F old:= %12.10e, F new: %12.10e\n",*f,fnew); CHKERRQ(info);
}
*f=fnew;
*f_full = fnew;
*info2 = 0;
TaoFunctionReturn(0);
}
PetscErrorCode PetscLs(MPI_Comm comm,const char libname[],char found[],size_t tlen,PetscBool *flg)
{
PetscErrorCode ierr;
size_t len;
char *f,program[PETSC_MAX_PATH_LEN];
FILE *fp;
PetscFunctionBegin;
ierr = PetscStrcpy(program,"ls ");CHKERRQ(ierr);
ierr = PetscStrcat(program,libname);CHKERRQ(ierr);
#if defined(PETSC_HAVE_POPEN)
ierr = PetscPOpen(comm,PETSC_NULL,program,"r",&fp);CHKERRQ(ierr);
#else
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
#endif
f = fgets(found,tlen,fp);
if (f) *flg = PETSC_TRUE; else *flg = PETSC_FALSE;
while (f) {
ierr = PetscStrlen(found,&len);CHKERRQ(ierr);
f = fgets(found+len,tlen-len,fp);
}
if (*flg) {ierr = PetscInfo2(0,"ls on %s gives \n%s\n",libname,found);CHKERRQ(ierr);}
#if defined(PETSC_HAVE_POPEN)
ierr = PetscPClose(comm,fp);CHKERRQ(ierr);
#else
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
#endif
PetscFunctionReturn(0);
}
/*@
MatMFFDCheckPositivity - Checks that all entries in U + h*a are positive or
zero, decreases h until this is satisfied.
Logically Collective on Vec
Input Parameters:
+ U - base vector that is added to
. a - vector that is added
. h - scaling factor on a
- dummy - context variable (unused)
Options Database Keys:
. -mat_mffd_check_positivity
Level: advanced
Notes:
This is rarely used directly, rather it is passed as an argument to
MatMFFDSetCheckh()
.seealso: MatMFFDSetCheckh()
@*/
PetscErrorCode MatMFFDCheckPositivity(void *dummy,Vec U,Vec a,PetscScalar *h)
{
PetscReal val, minval;
PetscScalar *u_vec, *a_vec;
PetscErrorCode ierr;
PetscInt i,n;
MPI_Comm comm;
PetscFunctionBegin;
PetscValidHeaderSpecific(U,VEC_CLASSID,2);
PetscValidHeaderSpecific(a,VEC_CLASSID,3);
PetscValidPointer(h,4);
ierr = PetscObjectGetComm((PetscObject)U,&comm);CHKERRQ(ierr);
ierr = VecGetArray(U,&u_vec);CHKERRQ(ierr);
ierr = VecGetArray(a,&a_vec);CHKERRQ(ierr);
ierr = VecGetLocalSize(U,&n);CHKERRQ(ierr);
minval = PetscAbsScalar(*h)*PetscRealConstant(1.01);
for (i=0; i<n; i++) {
if (PetscRealPart(u_vec[i] + *h*a_vec[i]) <= 0.0) {
val = PetscAbsScalar(u_vec[i]/a_vec[i]);
if (val < minval) minval = val;
}
}
ierr = VecRestoreArray(U,&u_vec);CHKERRQ(ierr);
ierr = VecRestoreArray(a,&a_vec);CHKERRQ(ierr);
ierr = MPIU_Allreduce(&minval,&val,1,MPIU_REAL,MPIU_MIN,comm);CHKERRQ(ierr);
if (val <= PetscAbsScalar(*h)) {
ierr = PetscInfo2(U,"Scaling back h from %g to %g\n",(double)PetscRealPart(*h),(double)(.99*val));CHKERRQ(ierr);
if (PetscRealPart(*h) > 0.0) *h = 0.99*val;
else *h = -0.99*val;
}
PetscFunctionReturn(0);
}
static PetscErrorCode KSPSetUp_PIPEFCG(KSP ksp)
{
PetscErrorCode ierr;
KSP_PIPEFCG *pipefcg;
const PetscInt nworkstd = 5;
PetscFunctionBegin;
pipefcg = (KSP_PIPEFCG*)ksp->data;
/* Allocate "standard" work vectors (not including the basis and transformed basis vectors) */
ierr = KSPSetWorkVecs(ksp,nworkstd);CHKERRQ(ierr);
/* Allocated space for pointers to additional work vectors
note that mmax is the number of previous directions, so we add 1 for the current direction,
and an extra 1 for the prealloc (which might be empty) */
ierr = PetscMalloc4(pipefcg->mmax+1,&(pipefcg->Pvecs),pipefcg->mmax+1,&(pipefcg->pPvecs),pipefcg->mmax+1,&(pipefcg->Svecs),pipefcg->mmax+1,&(pipefcg->pSvecs));CHKERRQ(ierr);
ierr = PetscMalloc4(pipefcg->mmax+1,&(pipefcg->Qvecs),pipefcg->mmax+1,&(pipefcg->pQvecs),pipefcg->mmax+1,&(pipefcg->ZETAvecs),pipefcg->mmax+1,&(pipefcg->pZETAvecs));CHKERRQ(ierr);
ierr = PetscMalloc4(pipefcg->mmax+1,&(pipefcg->Pold),pipefcg->mmax+1,&(pipefcg->Sold),pipefcg->mmax+1,&(pipefcg->Qold),pipefcg->mmax+1,&(pipefcg->ZETAold));CHKERRQ(ierr);
ierr = PetscMalloc1(pipefcg->mmax+1,&(pipefcg->chunksizes));CHKERRQ(ierr);
ierr = PetscMalloc3(pipefcg->mmax+2,&(pipefcg->dots),pipefcg->mmax+1,&(pipefcg->etas),pipefcg->mmax+2,&(pipefcg->redux));CHKERRQ(ierr);
/* If the requested number of preallocated vectors is greater than mmax reduce nprealloc */
if(pipefcg->nprealloc > pipefcg->mmax+1){
ierr = PetscInfo2(NULL,"Requested nprealloc=%d is greater than m_max+1=%d. Resetting nprealloc = m_max+1.\n",pipefcg->nprealloc, pipefcg->mmax+1);CHKERRQ(ierr);
}
/* Preallocate additional work vectors */
ierr = KSPAllocateVectors_PIPEFCG(ksp,pipefcg->nprealloc,pipefcg->nprealloc);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)ksp,(pipefcg->mmax+1)*4*sizeof(Vec*)+(pipefcg->mmax+1)*4*sizeof(Vec**)+(pipefcg->mmax+1)*4*sizeof(Vec*)+
(pipefcg->mmax+1)*sizeof(PetscInt)+(pipefcg->mmax+2)*sizeof(Vec*)+(pipefcg->mmax+2)*sizeof(PetscScalar)+(pipefcg->mmax+1)*sizeof(PetscReal));CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSStep_Pseudo(TS ts)
{
TS_Pseudo *pseudo = (TS_Pseudo*)ts->data;
PetscInt its,lits,reject;
PetscBool stepok;
PetscReal next_time_step;
SNESConvergedReason snesreason = SNES_CONVERGED_ITERATING;
PetscErrorCode ierr;
PetscFunctionBegin;
if (ts->steps == 0) pseudo->dt_initial = ts->time_step;
ierr = VecCopy(ts->vec_sol,pseudo->update);CHKERRQ(ierr);
next_time_step = ts->time_step;
ierr = TSPseudoComputeTimeStep(ts,&next_time_step);CHKERRQ(ierr);
for (reject=0; reject<ts->max_reject; reject++,ts->reject++) {
ts->time_step = next_time_step;
ierr = TSPreStep(ts);CHKERRQ(ierr);
ierr = TSPreStage(ts,ts->ptime+ts->time_step);CHKERRQ(ierr);
ierr = SNESSolve(ts->snes,NULL,pseudo->update);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(ts->snes,&snesreason);CHKERRQ(ierr);
ierr = SNESGetLinearSolveIterations(ts->snes,&lits);CHKERRQ(ierr);
ierr = SNESGetIterationNumber(ts->snes,&its);CHKERRQ(ierr);
ierr = TSPostStage(ts,ts->ptime+ts->time_step,0,&(pseudo->update));CHKERRQ(ierr);
ts->snes_its += its; ts->ksp_its += lits;
ierr = PetscInfo3(ts,"step=%D, nonlinear solve iterations=%D, linear solve iterations=%D\n",ts->steps,its,lits);CHKERRQ(ierr);
pseudo->fnorm = -1; /* The current norm is no longer valid, monitor must recompute it. */
ierr = TSPseudoVerifyTimeStep(ts,pseudo->update,&next_time_step,&stepok);CHKERRQ(ierr);
if (stepok) break;
}
if (snesreason < 0 && ts->max_snes_failures > 0 && ++ts->num_snes_failures >= ts->max_snes_failures) {
ts->reason = TS_DIVERGED_NONLINEAR_SOLVE;
ierr = PetscInfo2(ts,"step=%D, nonlinear solve solve failures %D greater than current TS allowed, stopping solve\n",ts->steps,ts->num_snes_failures);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (reject >= ts->max_reject) {
ts->reason = TS_DIVERGED_STEP_REJECTED;
ierr = PetscInfo2(ts,"step=%D, step rejections %D greater than current TS allowed, stopping solve\n",ts->steps,reject);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
ierr = VecCopy(pseudo->update,ts->vec_sol);CHKERRQ(ierr);
ts->ptime += ts->time_step;
ts->time_step = next_time_step;
ts->steps++;
PetscFunctionReturn(0);
}
static PetscErrorCode TSAdaptChoose_Basic(TSAdapt adapt,TS ts,PetscReal h,PetscInt *next_sc,PetscReal *next_h,PetscBool *accept,PetscReal *wlte)
{
TSAdapt_Basic *basic = (TSAdapt_Basic*)adapt->data;
PetscErrorCode ierr;
Vec X,Y;
PetscReal enorm,hfac_lte,h_lte,safety;
PetscInt order,stepno;
PetscFunctionBegin;
ierr = TSGetTimeStepNumber(ts,&stepno);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
if (!basic->Y) {ierr = VecDuplicate(X,&basic->Y);CHKERRQ(ierr);}
Y = basic->Y;
order = adapt->candidates.order[0];
ierr = TSEvaluateStep(ts,order-1,Y,NULL);CHKERRQ(ierr);
safety = basic->safety;
ierr = TSErrorNormWRMS(ts,Y,&enorm);CHKERRQ(ierr);
if (enorm > 1.) {
if (!*accept) safety *= basic->reject_safety; /* The last attempt also failed, shorten more aggressively */
if (h < (1 + PETSC_SQRT_MACHINE_EPSILON)*adapt->dt_min) {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting because step size %g is at minimum\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
} else if (basic->always_accept) {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting step of size %g because always_accept is set\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
} else {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, rejecting step of size %g\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_FALSE;
}
} else {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting step of size %g\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
}
/* The optimal new step based purely on local truncation error for this step. */
hfac_lte = safety * PetscRealPart(PetscPowScalar((PetscScalar)enorm,(PetscReal)(-1./order)));
h_lte = h * PetscClipInterval(hfac_lte,basic->clip[0],basic->clip[1]);
*next_sc = 0;
*next_h = PetscClipInterval(h_lte,adapt->dt_min,adapt->dt_max);
*wlte = enorm;
PetscFunctionReturn(0);
}
static PetscErrorCode SNESSolve_KSPONLY(SNES snes)
{
PetscErrorCode ierr;
PetscInt lits;
Vec Y,X,F;
PetscFunctionBegin;
if (snes->xl || snes->xu || snes->ops->computevariablebounds) {
SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_ARG_WRONGSTATE, "SNES solver %s does not support bounds", ((PetscObject)snes)->type_name);
}
snes->numFailures = 0;
snes->numLinearSolveFailures = 0;
snes->reason = SNES_CONVERGED_ITERATING;
snes->iter = 0;
snes->norm = 0.0;
X = snes->vec_sol;
F = snes->vec_func;
Y = snes->vec_sol_update;
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
if (snes->numbermonitors) {
PetscReal fnorm;
ierr = VecNorm(F,NORM_2,&fnorm);CHKERRQ(ierr);
ierr = SNESMonitor(snes,0,fnorm);CHKERRQ(ierr);
}
/* Call general purpose update function */
if (snes->ops->update) {
ierr = (*snes->ops->update)(snes, 0);CHKERRQ(ierr);
}
/* Solve J Y = F, where J is Jacobian matrix */
ierr = SNESComputeJacobian(snes,X,snes->jacobian,snes->jacobian_pre);CHKERRQ(ierr);
ierr = KSPSetOperators(snes->ksp,snes->jacobian,snes->jacobian_pre);CHKERRQ(ierr);
ierr = KSPSolve(snes->ksp,F,Y);CHKERRQ(ierr);
snes->reason = SNES_CONVERGED_ITS;
SNESCheckKSPSolve(snes);
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = PetscInfo2(snes,"iter=%D, linear solve iterations=%D\n",snes->iter,lits);CHKERRQ(ierr);
snes->iter++;
/* Take the computed step. */
ierr = VecAXPY(X,-1.0,Y);CHKERRQ(ierr);
if (snes->numbermonitors) {
PetscReal fnorm;
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
ierr = VecNorm(F,NORM_2,&fnorm);CHKERRQ(ierr);
ierr = SNESMonitor(snes,1,fnorm);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@
MatMultEqual - Compares matrix-vector products of two matrices.
Collective on Mat
Input Parameters:
+ A - the first matrix
- B - the second matrix
- n - number of random vectors to be tested
Output Parameter:
. flg - PETSC_TRUE if the products are equal; PETSC_FALSE otherwise.
Level: intermediate
Concepts: matrices^equality between
@*/
PetscErrorCode MatMultEqual(Mat A,Mat B,PetscInt n,PetscBool *flg)
{
PetscErrorCode ierr;
Vec x,s1,s2;
PetscRandom rctx;
PetscReal r1,r2,tol=1.e-10;
PetscInt am,an,bm,bn,k;
PetscScalar none = -1.0;
PetscFunctionBegin;
PetscValidHeaderSpecific(A,MAT_CLASSID,1);
PetscValidHeaderSpecific(B,MAT_CLASSID,2);
ierr = MatGetLocalSize(A,&am,&an);CHKERRQ(ierr);
ierr = MatGetLocalSize(B,&bm,&bn);CHKERRQ(ierr);
if (am != bm || an != bn) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Mat A,Mat B: local dim %D %D %D %D",am,bm,an,bn);
PetscCheckSameComm(A,1,B,2);
#if defined(PETSC_USE_REAL_SINGLE)
tol = 1.e-5;
#endif
ierr = PetscRandomCreate(((PetscObject)A)->comm,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = VecCreate(((PetscObject)A)->comm,&x);CHKERRQ(ierr);
ierr = VecSetSizes(x,an,PETSC_DECIDE);CHKERRQ(ierr);
ierr = VecSetFromOptions(x);CHKERRQ(ierr);
ierr = VecCreate(((PetscObject)A)->comm,&s1);CHKERRQ(ierr);
ierr = VecSetSizes(s1,am,PETSC_DECIDE);CHKERRQ(ierr);
ierr = VecSetFromOptions(s1);CHKERRQ(ierr);
ierr = VecDuplicate(s1,&s2);CHKERRQ(ierr);
*flg = PETSC_TRUE;
for (k=0; k<n; k++) {
ierr = VecSetRandom(x,rctx);CHKERRQ(ierr);
ierr = MatMult(A,x,s1);CHKERRQ(ierr);
ierr = MatMult(B,x,s2);CHKERRQ(ierr);
ierr = VecNorm(s2,NORM_INFINITY,&r2);CHKERRQ(ierr);
if (r2 < tol){
ierr = VecNorm(s1,NORM_INFINITY,&r1);CHKERRQ(ierr);
} else {
ierr = VecAXPY(s2,none,s1);CHKERRQ(ierr);
ierr = VecNorm(s2,NORM_INFINITY,&r1);CHKERRQ(ierr);
r1 /= r2;
}
if (r1 > tol) {
*flg = PETSC_FALSE;
ierr = PetscInfo2(A,"Error: %D-th MatMult() %G\n",k,r1);CHKERRQ(ierr);
break;
}
}
ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&s1);CHKERRQ(ierr);
ierr = VecDestroy(&s2);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatAssemblyBegin_Preallocator(Mat A, MatAssemblyType type)
{
PetscInt nstash, reallocs;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscLayoutSetUp(A->rmap);CHKERRQ(ierr);
ierr = MatStashScatterBegin_Private(A, &A->stash, A->rmap->range);CHKERRQ(ierr);
ierr = MatStashGetInfo_Private(&A->stash, &nstash, &reallocs);CHKERRQ(ierr);
ierr = PetscInfo2(A, "Stash has %D entries, uses %D mallocs.\n", nstash, reallocs);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
This convergence test determines if the two norm of the
solution lies outside the trust region, if so it halts.
*/
static PetscErrorCode SNESTR_KSPConverged_Private(KSP ksp,PetscInt n,PetscReal rnorm,KSPConvergedReason *reason,void *cctx)
{
SNES_TR_KSPConverged_Ctx *ctx = (SNES_TR_KSPConverged_Ctx*)cctx;
SNES snes = ctx->snes;
SNES_NEWTONTR *neP = (SNES_NEWTONTR*)snes->data;
Vec x;
PetscReal nrm;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = KSPConvergedDefault(ksp,n,rnorm,reason,ctx->ctx);CHKERRQ(ierr);
if (*reason) {
ierr = PetscInfo2(snes,"default convergence test KSP iterations=%D, rnorm=%g\n",n,(double)rnorm);CHKERRQ(ierr);
}
/* Determine norm of solution */
ierr = KSPBuildSolution(ksp,0,&x);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&nrm);CHKERRQ(ierr);
if (nrm >= neP->delta) {
ierr = PetscInfo2(snes,"Ending linear iteration early, delta=%g, length=%g\n",(double)neP->delta,(double)nrm);CHKERRQ(ierr);
*reason = KSP_CONVERGED_STEP_LENGTH;
}
PetscFunctionReturn(0);
}
/*@C
PetscOpenMPMerge - Initializes the PETSc and MPI to work with OpenMP. This is not usually called
by the user. One should use -openmp_merge_size <n> to indicate the node size of merged communicator
to be.
Collective on MPI_COMM_WORLD or PETSC_COMM_WORLD if it has been set
Input Parameter:
+ nodesize - size of each compute node that will share processors
. func - optional function to call on the master nodes
- ctx - context passed to function on master nodes
Options Database:
. -openmp_merge_size <n>
Level: developer
$ Comparison of two approaches for OpenMP usage (MPI started with N processes)
$
$ -openmp_spawn_size <n> requires MPI 2, results in n*N total processes with N directly used by application code
$ and n-1 worker processes (used by PETSc) for each application node.
$ You MUST launch MPI so that only ONE MPI process is created for each hardware node.
$
$ -openmp_merge_size <n> results in N total processes, N/n used by the application code and the rest worker processes
$ (used by PETSc)
$ You MUST launch MPI so that n MPI processes are created for each hardware node.
$
$ petscmpiexec -n 2 ./ex1 -openmp_spawn_size 3 gives 2 application nodes (and 4 PETSc worker nodes)
$ petscmpiexec -n 6 ./ex1 -openmp_merge_size 3 gives the SAME 2 application nodes and 4 PETSc worker nodes
$ This is what would use if each of the computers hardware nodes had 3 CPUs.
$
$ These are intended to be used in conjunction with USER OpenMP code. The user will have 1 process per
$ computer (hardware) node (where the computer node has p cpus), the user's code will use threads to fully
$ utilize all the CPUs on the node. The PETSc code will have p processes to fully use the compute node for
$ PETSc calculations. The user THREADS and PETSc PROCESSES will NEVER run at the same time so the p CPUs
$ are always working on p task, never more than p.
$
$ See PCOPENMP for a PETSc preconditioner that can use this functionality
$
For both PetscOpenMPSpawn() and PetscOpenMPMerge() PETSC_COMM_WORLD consists of one process per "node", PETSC_COMM_LOCAL_WORLD
consists of all the processes in a "node."
In both cases the user's code is running ONLY on PETSC_COMM_WORLD (that was newly generated by running this command).
Concepts: OpenMP
.seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscOpenMPFinalize(), PetscInitialize(), PetscOpenMPSpawn(), PetscOpenMPRun()
@*/
PetscErrorCode PETSC_DLLEXPORT PetscOpenMPMerge(PetscMPIInt nodesize,PetscErrorCode (*func)(void*),void *ctx)
{
PetscErrorCode ierr;
PetscMPIInt size,rank,*ranks,i;
MPI_Group group,newgroup;
PetscFunctionBegin;
saved_PETSC_COMM_WORLD = PETSC_COMM_WORLD;
ierr = MPI_Comm_size(saved_PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size % nodesize) SETERRQ2(PETSC_ERR_ARG_SIZ,"Total number of process nodes %d is not divisible by number of processes per node %d",size,nodesize);
ierr = MPI_Comm_rank(saved_PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
/* create two communicators
*) one that contains the first process from each node: 0,nodesize,2*nodesize,...
*) one that contains all processes in a node: (0,1,2...,nodesize-1), (nodesize,nodesize+1,...2*nodesize-), ...
*/
ierr = MPI_Comm_group(saved_PETSC_COMM_WORLD,&group);CHKERRQ(ierr);
ierr = PetscMalloc((size/nodesize)*sizeof(PetscMPIInt),&ranks);CHKERRQ(ierr);
for (i=0; i<(size/nodesize); i++) ranks[i] = i*nodesize;
ierr = MPI_Group_incl(group,size/nodesize,ranks,&newgroup);CHKERRQ(ierr);
ierr = PetscFree(ranks);CHKERRQ(ierr);
ierr = MPI_Comm_create(saved_PETSC_COMM_WORLD,newgroup,&PETSC_COMM_WORLD);CHKERRQ(ierr);
if (rank % nodesize) PETSC_COMM_WORLD = 0; /* mark invalid processes for easy debugging */
ierr = MPI_Group_free(&group);CHKERRQ(ierr);
ierr = MPI_Group_free(&newgroup);CHKERRQ(ierr);
ierr = MPI_Comm_split(saved_PETSC_COMM_WORLD,rank/nodesize,rank % nodesize,&PETSC_COMM_LOCAL_WORLD);CHKERRQ(ierr);
ierr = PetscInfo2(0,"PETSc OpenMP successfully started: number of nodes = %d node size = %d\n",size/nodesize,nodesize);CHKERRQ(ierr);
ierr = PetscInfo1(0,"PETSc OpenMP process %sactive\n",(rank % nodesize) ? "in" : "");CHKERRQ(ierr);
PetscOpenMPCtx = ctx;
/*
All process not involved in user application code wait here
*/
if (!PETSC_COMM_WORLD) {
ierr = PetscOpenMPHandle(PETSC_COMM_LOCAL_WORLD);CHKERRQ(ierr);
PETSC_COMM_WORLD = saved_PETSC_COMM_WORLD;
PetscOpenMPWorker = PETSC_TRUE; /* so that PetscOpenMPIFinalize() will not attempt a broadcast from this process */
ierr = PetscInfo(0,"PETSc OpenMP inactive process becoming active");CHKERRQ(ierr);
} else {
if (func) {
ierr = (*func)(ctx);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
static PetscErrorCode KSPGMRESBuildSoln(PetscScalar *nrs,Vec vs,Vec vdest,KSP ksp,PetscInt it)
{
PetscScalar tt;
PetscErrorCode ierr;
PetscInt ii,k,j;
KSP_GMRES *gmres = (KSP_GMRES*)(ksp->data);
PetscFunctionBegin;
/* Solve for solution vector that minimizes the residual */
/* If it is < 0, no gmres steps have been performed */
if (it < 0) {
ierr = VecCopy(vs,vdest);CHKERRQ(ierr); /* VecCopy() is smart, exists immediately if vguess == vdest */
PetscFunctionReturn(0);
}
if (*HH(it,it) != 0.0) {
nrs[it] = *GRS(it) / *HH(it,it);
} else {
ksp->reason = KSP_DIVERGED_BREAKDOWN;
ierr = PetscInfo2(ksp,"Likely your matrix or preconditioner is singular. HH(it,it) is identically zero; it = %D GRS(it) = %G",it,PetscAbsScalar(*GRS(it)));CHKERRQ(ierr);
PetscFunctionReturn(0);
}
for (ii=1; ii<=it; ii++) {
k = it - ii;
tt = *GRS(k);
for (j=k+1; j<=it; j++) tt = tt - *HH(k,j) * nrs[j];
if (*HH(k,k) == 0.0) {
ksp->reason = KSP_DIVERGED_BREAKDOWN;
ierr = PetscInfo1(ksp,"Likely your matrix or preconditioner is singular. HH(k,k) is identically zero; k = %D",k);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
nrs[k] = tt / *HH(k,k);
}
/* Accumulate the correction to the solution of the preconditioned problem in TEMP */
ierr = VecSet(VEC_TEMP,0.0);CHKERRQ(ierr);
ierr = VecMAXPY(VEC_TEMP,it+1,nrs,&VEC_VV(0));CHKERRQ(ierr);
ierr = KSPUnwindPreconditioner(ksp,VEC_TEMP,VEC_TEMP_MATOP);CHKERRQ(ierr);
/* add solution to previous solution */
if (vdest != vs) {
ierr = VecCopy(vs,vdest);CHKERRQ(ierr);
}
ierr = VecAXPY(vdest,1.0,VEC_TEMP);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSStep_Theta(TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscInt its,lits;
PetscReal next_time_step;
SNESConvergedReason snesreason;
PetscErrorCode ierr;
PetscFunctionBegin;
next_time_step = ts->time_step;
th->stage_time = ts->ptime + (th->endpoint ? 1. : th->Theta)*ts->time_step;
th->shift = 1./(th->Theta*ts->time_step);
ierr = TSPreStep(ts);CHKERRQ(ierr);
ierr = TSPreStage(ts,th->stage_time);CHKERRQ(ierr);
if (th->endpoint) { /* This formulation assumes linear time-independent mass matrix */
ierr = VecZeroEntries(th->Xdot);CHKERRQ(ierr);
if (!th->affine) {ierr = VecDuplicate(ts->vec_sol,&th->affine);CHKERRQ(ierr);}
ierr = TSComputeIFunction(ts,ts->ptime,ts->vec_sol,th->Xdot,th->affine,PETSC_FALSE);CHKERRQ(ierr);
ierr = VecScale(th->affine,(th->Theta-1.)/th->Theta);CHKERRQ(ierr);
}
if (th->extrapolate) {
ierr = VecWAXPY(th->X,1./th->shift,th->Xdot,ts->vec_sol);CHKERRQ(ierr);
} else {
ierr = VecCopy(ts->vec_sol,th->X);CHKERRQ(ierr);
}
ierr = SNESSolve(ts->snes,th->affine,th->X);CHKERRQ(ierr);
ierr = SNESGetIterationNumber(ts->snes,&its);CHKERRQ(ierr);
ierr = SNESGetLinearSolveIterations(ts->snes,&lits);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(ts->snes,&snesreason);CHKERRQ(ierr);
ts->snes_its += its; ts->ksp_its += lits;
if (snesreason < 0 && ts->max_snes_failures > 0 && ++ts->num_snes_failures >= ts->max_snes_failures) {
ts->reason = TS_DIVERGED_NONLINEAR_SOLVE;
ierr = PetscInfo2(ts,"Step=%D, nonlinear solve solve failures %D greater than current TS allowed, stopping solve\n",ts->steps,ts->num_snes_failures);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (th->endpoint) {
ierr = VecCopy(th->X,ts->vec_sol);CHKERRQ(ierr);
} else {
ierr = VecAXPBYPCZ(th->Xdot,-th->shift,th->shift,0,ts->vec_sol,th->X);CHKERRQ(ierr);
ierr = VecAXPY(ts->vec_sol,ts->time_step,th->Xdot);CHKERRQ(ierr);
}
ts->ptime += ts->time_step;
ts->time_step = next_time_step;
ts->steps++;
PetscFunctionReturn(0);
}
/*@C
DMDAGetProcessorSubset - Returns a communicator consisting only of the
processors in a DMDA that own a particular global x, y, or z grid point
(corresponding to a logical plane in a 3D grid or a line in a 2D grid).
Collective on DMDA
Input Parameters:
+ da - the distributed array
. dir - Cartesian direction, either DMDA_X, DMDA_Y, or DMDA_Z
- gp - global grid point number in this direction
Output Parameters:
. comm - new communicator
Level: advanced
Notes:
All processors that share the DMDA must call this with the same gp value
This routine is particularly useful to compute boundary conditions
or other application-specific calculations that require manipulating
sets of data throughout a logical plane of grid points.
.keywords: distributed array, get, processor subset
@*/
PetscErrorCode DMDAGetProcessorSubset(DM da,DMDADirection dir,PetscInt gp,MPI_Comm *comm)
{
MPI_Group group,subgroup;
PetscErrorCode ierr;
PetscInt i,ict,flag,*owners,xs,xm,ys,ym,zs,zm;
PetscMPIInt size,*ranks = NULL;
DM_DA *dd = (DM_DA*)da->data;
PetscFunctionBegin;
PetscValidHeaderSpecific(da,DM_CLASSID,1);
flag = 0;
ierr = DMDAGetCorners(da,&xs,&ys,&zs,&xm,&ym,&zm);CHKERRQ(ierr);
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)da),&size);CHKERRQ(ierr);
if (dir == DMDA_Z) {
if (da->dim < 3) SETERRQ(PetscObjectComm((PetscObject)da),PETSC_ERR_ARG_OUTOFRANGE,"DMDA_Z invalid for DMDA dim < 3");
if (gp < 0 || gp > dd->P) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"invalid grid point");
if (gp >= zs && gp < zs+zm) flag = 1;
} else if (dir == DMDA_Y) {
if (da->dim == 1) SETERRQ(PetscObjectComm((PetscObject)da),PETSC_ERR_ARG_OUTOFRANGE,"DMDA_Y invalid for DMDA dim = 1");
if (gp < 0 || gp > dd->N) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"invalid grid point");
if (gp >= ys && gp < ys+ym) flag = 1;
} else if (dir == DMDA_X) {
if (gp < 0 || gp > dd->M) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"invalid grid point");
if (gp >= xs && gp < xs+xm) flag = 1;
} else SETERRQ(PetscObjectComm((PetscObject)da),PETSC_ERR_ARG_OUTOFRANGE,"Invalid direction");
ierr = PetscMalloc2(size,&owners,size,&ranks);CHKERRQ(ierr);
ierr = MPI_Allgather(&flag,1,MPIU_INT,owners,1,MPIU_INT,PetscObjectComm((PetscObject)da));CHKERRQ(ierr);
ict = 0;
ierr = PetscInfo2(da,"DMDAGetProcessorSubset: dim=%D, direction=%d, procs: ",da->dim,(int)dir);CHKERRQ(ierr);
for (i=0; i<size; i++) {
if (owners[i]) {
ranks[ict] = i; ict++;
ierr = PetscInfo1(da,"%D ",i);CHKERRQ(ierr);
}
}
ierr = PetscInfo(da,"\n");CHKERRQ(ierr);
ierr = MPI_Comm_group(PetscObjectComm((PetscObject)da),&group);CHKERRQ(ierr);
ierr = MPI_Group_incl(group,ict,ranks,&subgroup);CHKERRQ(ierr);
ierr = MPI_Comm_create(PetscObjectComm((PetscObject)da),subgroup,comm);CHKERRQ(ierr);
ierr = MPI_Group_free(&subgroup);CHKERRQ(ierr);
ierr = MPI_Group_free(&group);CHKERRQ(ierr);
ierr = PetscFree2(owners,ranks);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
KSPMonitorAMS - monitor solution using AMS
Logically Collective on KSP
Input Parameters:
+ ksp - iterative context
. n - iteration number
. rnorm - 2-norm (preconditioned) residual value (may be estimated).
- ctx - PetscViewer of type AMS
Level: advanced
.keywords: KSP, CG, monitor, AMS, singular values
.seealso: KSPMonitorSingularValue(), KSPComputeExtremeSingularValues(), PetscViewerAMSOpen()
@*/
PetscErrorCode KSPMonitorAMS(KSP ksp,PetscInt n,PetscReal rnorm,void *ctx)
{
#if defined(PETSC_HAVE_AMS)
PetscErrorCode ierr;
KSPMonitor_AMS *mon = (KSPMonitor_AMS*)ctx;
PetscViewer viewer = mon->viewer;
PetscReal emax,emin;;
AMS_Comm acomm;
PetscFunctionBegin;
PetscValidHeaderSpecific(ksp,KSP_CLASSID,1);
PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,4);
ierr = KSPComputeExtremeSingularValues(ksp,&emax,&emin);CHKERRQ(ierr);
/* UnPublish */
if (mon->amem != -1) {ierr = AMS_Memory_destroy(mon->amem);CHKERRQ(ierr);}
mon->amem = -1;
ierr = PetscFree(mon->eigr);CHKERRQ(ierr);
ierr = PetscMalloc(2*n*sizeof(PetscReal),&mon->eigr);CHKERRQ(ierr);
mon->eigi = mon->eigr + n;
if (n) {ierr = KSPComputeEigenvalues(ksp,n,mon->eigr,mon->eigi,&mon->neigs);CHKERRQ(ierr);}
ierr = PetscViewerAMSGetAMSComm(viewer,&acomm);CHKERRQ(ierr);
ierr = AMS_Memory_create(acomm,"ksp_monitor_ams",&mon->amem);CHKERRQ(ierr);
ierr = AMS_Memory_take_access(mon->amem);CHKERRQ(ierr);
ierr = AMS_Memory_add_field(mon->amem,"rnorm",&ksp->rnorm,1,AMS_DOUBLE,AMS_READ,AMS_COMMON,AMS_REDUCT_UNDEF);CHKERRQ(ierr);
ierr = AMS_Memory_add_field(mon->amem,"neigs",&mon->neigs,1,AMS_INT,AMS_READ,AMS_COMMON,AMS_REDUCT_UNDEF);CHKERRQ(ierr);
if (mon->neigs > 0) {
ierr = AMS_Memory_add_field(mon->amem,"eigr",&mon->eigr,mon->neigs,AMS_DOUBLE,AMS_READ,AMS_COMMON,AMS_REDUCT_UNDEF);CHKERRQ(ierr);
ierr = AMS_Memory_add_field(mon->amem,"eigi",&mon->eigr,mon->neigs,AMS_DOUBLE,AMS_READ,AMS_COMMON,AMS_REDUCT_UNDEF);CHKERRQ(ierr);
}
ierr = AMS_Memory_publish(mon->amem);CHKERRQ(ierr);
ierr = AMS_Memory_grant_access(mon->amem);CHKERRQ(ierr);
ierr = PetscInfo2(ksp,"KSP extreme singular values min=%G max=%G\n",emin,emax);CHKERRQ(ierr);
PetscFunctionReturn(0);
#else
PetscFunctionBegin;
SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_SUP,"Missing package AMS");
PetscFunctionReturn(0);
#endif
}
/*@
TSAdaptCheckStage - checks whether to accept a stage, (e.g. reject and change time step size if nonlinear solve fails)
Collective on TSAdapt
Input Arguments:
+ adapt - adaptive controller context
. ts - time stepper
. t - Current simulation time
- Y - Current solution vector
Output Arguments:
. accept - PETSC_TRUE to accept the stage, PETSC_FALSE to reject
Level: developer
.seealso:
@*/
PetscErrorCode TSAdaptCheckStage(TSAdapt adapt,TS ts,PetscReal t,Vec Y,PetscBool *accept)
{
PetscErrorCode ierr;
SNESConvergedReason snesreason = SNES_CONVERGED_ITERATING;
PetscFunctionBegin;
PetscValidHeaderSpecific(adapt,TSADAPT_CLASSID,1);
PetscValidHeaderSpecific(ts,TS_CLASSID,2);
PetscValidIntPointer(accept,3);
if (ts->snes) {ierr = SNESGetConvergedReason(ts->snes,&snesreason);CHKERRQ(ierr);}
if (snesreason < 0) {
*accept = PETSC_FALSE;
if (++ts->num_snes_failures >= ts->max_snes_failures && ts->max_snes_failures > 0) {
ts->reason = TS_DIVERGED_NONLINEAR_SOLVE;
ierr = PetscInfo2(ts,"Step=%D, nonlinear solve failures %D greater than current TS allowed, stopping solve\n",ts->steps,ts->num_snes_failures);CHKERRQ(ierr);
if (adapt->monitor) {
ierr = PetscViewerASCIIAddTab(adapt->monitor,((PetscObject)adapt)->tablevel);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(adapt->monitor," TSAdapt %s step %3D stage rejected t=%-11g+%10.3e, nonlinear solve failures %D greater than current TS allowed\n",((PetscObject)adapt)->type_name,ts->steps,(double)ts->ptime,(double)ts->time_step,ts->num_snes_failures);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(adapt->monitor,((PetscObject)adapt)->tablevel);CHKERRQ(ierr);
}
}
} else {
*accept = PETSC_TRUE;
ierr = TSFunctionDomainError(ts,t,Y,accept);CHKERRQ(ierr);
if(*accept && adapt->checkstage) {
ierr = (*adapt->checkstage)(adapt,ts,t,Y,accept);CHKERRQ(ierr);
}
}
if(!(*accept) && !ts->reason) {
PetscReal dt,new_dt;
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
new_dt = dt * adapt->scale_solve_failed;
ierr = TSSetTimeStep(ts,new_dt);CHKERRQ(ierr);
adapt->timestepjustdecreased += adapt->timestepjustdecreased_delay;
if (adapt->monitor) {
ierr = PetscViewerASCIIAddTab(adapt->monitor,((PetscObject)adapt)->tablevel);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(adapt->monitor," TSAdapt %s step %3D stage rejected (%s) t=%-11g+%10.3e retrying with dt=%-10.3e\n",((PetscObject)adapt)->type_name,ts->steps,SNESConvergedReasons[snesreason],(double)ts->ptime,(double)dt,(double)new_dt);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(adapt->monitor,((PetscObject)adapt)->tablevel);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
/*@C
PetscViewerSocketSetConnection - Sets the machine and port that a PETSc socket
viewer is to use
Logically Collective on PetscViewer
Input Parameters:
+ v - viewer to connect
. machine - host to connect to, use NULL for the local machine,use "server" to passively wait for
a connection from elsewhere
- port - the port on the machine one is connecting to, use PETSC_DEFAULT for default
Level: advanced
.seealso: PetscViewerSocketOpen()
@*/
PetscErrorCode PetscViewerSocketSetConnection(PetscViewer v,const char machine[],int port)
{
PetscErrorCode ierr;
PetscMPIInt rank;
char mach[256];
PetscBool tflg;
PetscViewer_Socket *vmatlab = (PetscViewer_Socket*)v->data;
PetscFunctionBegin;
/* PetscValidLogicalCollectiveInt(v,port,3); not a PetscInt */
if (port <= 0) {
char portn[16];
ierr = PetscOptionsGetenv(PetscObjectComm((PetscObject)v),"PETSC_VIEWER_SOCKET_PORT",portn,16,&tflg);CHKERRQ(ierr);
if (tflg) {
PetscInt pport;
ierr = PetscOptionsStringToInt(portn,&pport);CHKERRQ(ierr);
port = (int)pport;
} else port = PETSCSOCKETDEFAULTPORT;
}
if (!machine) {
ierr = PetscOptionsGetenv(PetscObjectComm((PetscObject)v),"PETSC_VIEWER_SOCKET_MACHINE",mach,256,&tflg);CHKERRQ(ierr);
if (!tflg) {
ierr = PetscGetHostName(mach,256);CHKERRQ(ierr);
}
} else {
ierr = PetscStrncpy(mach,machine,256);CHKERRQ(ierr);
}
ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)v),&rank);CHKERRQ(ierr);
if (!rank) {
ierr = PetscStrcmp(mach,"server",&tflg);CHKERRQ(ierr);
if (tflg) {
int listenport;
ierr = PetscInfo1(v,"Waiting for connection from socket process on port %D\n",port);CHKERRQ(ierr);
ierr = PetscSocketEstablish(port,&listenport);CHKERRQ(ierr);
ierr = PetscSocketListen(listenport,&vmatlab->port);CHKERRQ(ierr);
close(listenport);
} else {
ierr = PetscInfo2(v,"Connecting to socket process on port %D machine %s\n",port,mach);CHKERRQ(ierr);
ierr = PetscOpenSocket(mach,port,&vmatlab->port);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
/*@C
DMDAGetProcessorSubsets - Returns communicators consisting only of the
processors in a DMDA adjacent in a particular dimension,
corresponding to a logical plane in a 3D grid or a line in a 2D grid.
Collective on DMDA
Input Parameters:
+ da - the distributed array
- dir - Cartesian direction, either DMDA_X, DMDA_Y, or DMDA_Z
Output Parameters:
. subcomm - new communicator
Level: advanced
Notes:
This routine is useful for distributing one-dimensional data in a tensor product grid.
.keywords: distributed array, get, processor subset
@*/
PetscErrorCode DMDAGetProcessorSubsets(DM da, DMDADirection dir, MPI_Comm *subcomm)
{
MPI_Comm comm;
MPI_Group group, subgroup;
PetscInt subgroupSize = 0;
PetscInt *firstPoints;
PetscMPIInt size, *subgroupRanks = NULL;
PetscInt xs, xm, ys, ym, zs, zm, firstPoint, p;
PetscErrorCode ierr;
DM_DA *dd = (DM_DA*)da->data;
PetscFunctionBegin;
PetscValidHeaderSpecific(da, DM_CLASSID, 1);
ierr = PetscObjectGetComm((PetscObject)da,&comm);CHKERRQ(ierr);
ierr = DMDAGetCorners(da, &xs, &ys, &zs, &xm, &ym, &zm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
if (dir == DMDA_Z) {
if (dd->dim < 3) SETERRQ(comm,PETSC_ERR_ARG_OUTOFRANGE,"DMDA_Z invalid for DMDA dim < 3");
firstPoint = zs;
} else if (dir == DMDA_Y) {
if (dd->dim == 1) SETERRQ(comm,PETSC_ERR_ARG_OUTOFRANGE,"DMDA_Y invalid for DMDA dim = 1");
firstPoint = ys;
} else if (dir == DMDA_X) {
firstPoint = xs;
} else SETERRQ(comm,PETSC_ERR_ARG_OUTOFRANGE,"Invalid direction");
ierr = PetscMalloc2(size, PetscInt, &firstPoints, size, PetscMPIInt, &subgroupRanks);CHKERRQ(ierr);
ierr = MPI_Allgather(&firstPoint, 1, MPIU_INT, firstPoints, 1, MPIU_INT, comm);CHKERRQ(ierr);
ierr = PetscInfo2(da,"DMDAGetProcessorSubset: dim=%D, direction=%d, procs: ",dd->dim,(int)dir);CHKERRQ(ierr);
for (p = 0; p < size; ++p) {
if (firstPoints[p] == firstPoint) {
subgroupRanks[subgroupSize++] = p;
ierr = PetscInfo1(da, "%D ", p);CHKERRQ(ierr);
}
}
ierr = PetscInfo(da, "\n");CHKERRQ(ierr);
ierr = MPI_Comm_group(comm, &group);CHKERRQ(ierr);
ierr = MPI_Group_incl(group, subgroupSize, subgroupRanks, &subgroup);CHKERRQ(ierr);
ierr = MPI_Comm_create(comm, subgroup, subcomm);CHKERRQ(ierr);
ierr = MPI_Group_free(&subgroup);CHKERRQ(ierr);
ierr = MPI_Group_free(&group);CHKERRQ(ierr);
ierr = PetscFree2(firstPoints, subgroupRanks);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TaoLineSearchApply_Unit(TaoLineSearch ls,Vec x,PetscReal *f,Vec g,Vec step_direction)
{
PetscErrorCode ierr;
PetscReal ftry;
PetscReal startf = *f;
PetscFunctionBegin;
/* Take unit step (newx = startx + 1.0*step_direction) */
ierr = VecAXPY(x,1.0,step_direction);CHKERRQ(ierr);
ierr = TaoLineSearchComputeObjectiveAndGradient(ls,x,&ftry,g);CHKERRQ(ierr);
ierr = PetscInfo1(ls,"Tao Apply Unit Step: %4.4e\n",1.0);CHKERRQ(ierr);
if (startf < ftry){
ierr = PetscInfo2(ls,"Tao Apply Unit Step, FINCREASE: F old:= %12.10e, F new: %12.10e\n",(double)startf,(double)ftry);CHKERRQ(ierr);
}
*f = ftry;
ls->step = 1.0;
ls->reason=TAOLINESEARCH_SUCCESS;
PetscFunctionReturn(0);
}
/*@C
PetscMatlabEngineCreate - Creates a MATLAB engine object
Not Collective
Input Parameters:
+ comm - a separate MATLAB engine is started for each process in the communicator
- machine - name of machine where MATLAB engine is to be run (usually NULL)
Output Parameter:
. mengine - the resulting object
Options Database:
. -matlab_engine_graphics - allow the MATLAB engine to display graphics
Level: advanced
.seealso: PetscMatlabEngineDestroy(), PetscMatlabEnginePut(), PetscMatlabEngineGet(),
PetscMatlabEngineEvaluate(), PetscMatlabEngineGetOutput(), PetscMatlabEnginePrintOutput(),
PETSC_MATLAB_ENGINE_(), PetscMatlabEnginePutArray(), PetscMatlabEngineGetArray(), PetscMatlabEngine
@*/
PetscErrorCode PetscMatlabEngineCreate(MPI_Comm comm,const char machine[],PetscMatlabEngine *mengine)
{
PetscErrorCode ierr;
PetscMPIInt rank,size;
char buffer[256];
PetscMatlabEngine e;
PetscBool flg = PETSC_FALSE;
PetscFunctionBegin;
if (MATLABENGINE_CLASSID == -1) {
ierr = PetscClassIdRegister("MATLAB Engine",&MATLABENGINE_CLASSID);CHKERRQ(ierr);
}
ierr = PetscOptionsGetBool(NULL,NULL,"-matlab_engine_graphics",&flg,NULL);CHKERRQ(ierr);
ierr = PetscHeaderCreate(e,MATLABENGINE_CLASSID,"MatlabEngine","MATLAB Engine","Sys",comm,PetscMatlabEngineDestroy,NULL);CHKERRQ(ierr);
if (!machine) machine = "\0";
ierr = PetscStrcpy(buffer,PETSC_MATLAB_COMMAND);CHKERRQ(ierr);
if (!flg) {
ierr = PetscStrcat(buffer," -nodisplay ");CHKERRQ(ierr);
}
ierr = PetscStrcat(buffer," -nojvm ");CHKERRQ(ierr);
ierr = PetscInfo2(0,"Starting MATLAB engine on %s with command %s\n",machine,buffer);CHKERRQ(ierr);
e->ep = engOpen(buffer);
if (!e->ep) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Unable to start MATLAB engine on %s",machine);
engOutputBuffer(e->ep,e->buffer,1024);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
sprintf(buffer,"MPI_Comm_rank = %d; MPI_Comm_size = %d;\n",rank,size);
engEvalString(e->ep, buffer);
ierr = PetscInfo1(0,"Started MATLAB engine on %s\n",machine);CHKERRQ(ierr);
*mengine = e;
PetscFunctionReturn(0);
}
