PETSC_EXTERN PetscErrorCode PetscDrawCreate_TikZ(PetscDraw draw)
{
PetscDraw_TikZ *win;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscMemcpy(draw->ops,&DvOps,sizeof(DvOps));CHKERRQ(ierr);
ierr = PetscNew(PetscDraw_TikZ,&win);CHKERRQ(ierr);
ierr = PetscLogObjectMemory(draw,sizeof(PetscDraw_TikZ));CHKERRQ(ierr);
draw->data = (void*) win;
if (draw->title) {
ierr = PetscStrallocpy(draw->title,&win->filename);CHKERRQ(ierr);
} else {
const char *fname;
ierr = PetscObjectGetName((PetscObject)draw,&fname);CHKERRQ(ierr);
ierr = PetscStrallocpy(fname,&win->filename);CHKERRQ(ierr);
}
ierr = PetscFOpen(PetscObjectComm((PetscObject)draw),win->filename,"w",&win->fd);CHKERRQ(ierr);
ierr = PetscFPrintf(PetscObjectComm((PetscObject)draw),win->fd,TikZ_BEGIN_DOCUMENT);CHKERRQ(ierr);
ierr = PetscFPrintf(PetscObjectComm((PetscObject)draw),win->fd,TikZ_BEGIN_FRAME);CHKERRQ(ierr);
win->written = PETSC_FALSE;
PetscFunctionReturn(0);
}
PetscErrorCode PetscCloseHistoryFile(FILE **fd)
{
PetscErrorCode ierr;
PetscMPIInt rank;
char date[64];
int err;
PetscFunctionBegin;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
CHKERRQ(ierr);
if (!rank) {
ierr = PetscGetDate(date,64);
CHKERRQ(ierr);
ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"---------------------------------------------------------\n");
CHKERRQ(ierr);
ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"Finished at %s\n",date);
CHKERRQ(ierr);
ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"---------------------------------------------------------\n");
CHKERRQ(ierr);
err = fflush(*fd);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
err = fclose(*fd);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
}
PetscFunctionReturn(0);
}
PetscErrorCode DMPlexVTKWriteField_ASCII(DM dm, PetscSection section, PetscSection globalSection, Vec field, const char name[], FILE *fp, PetscInt enforceDof, PetscInt precision, PetscReal scale)
{
MPI_Comm comm;
PetscInt numDof = 0, maxDof;
PetscInt pStart, pEnd, p;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
for (p = pStart; p < pEnd; ++p) {
ierr = PetscSectionGetDof(section, p, &numDof);CHKERRQ(ierr);
if (numDof) break;
}
numDof = PetscMax(numDof, enforceDof);
ierr = MPI_Allreduce(&numDof, &maxDof, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
if (!name) name = "Unknown";
if (maxDof == 3) {
ierr = PetscFPrintf(comm, fp, "VECTORS %s double\n", name);CHKERRQ(ierr);
} else {
ierr = PetscFPrintf(comm, fp, "SCALARS %s double %d\n", name, maxDof);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "LOOKUP_TABLE default\n");CHKERRQ(ierr);
}
ierr = DMPlexVTKWriteSection_ASCII(dm, section, globalSection, field, fp, enforceDof, precision, scale);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode monitorRelres(const VerboseLevel vl, const Vec x, const Vec right_precond, const PetscInt num_iter, const PetscReal rel_res, const Mat CF, const Vec conjParam, const Vec conjSrc, GridInfo *gi)
{
PetscFunctionBegin;
PetscErrorCode ierr;
if (gi->output_relres) {
ierr = PetscFPrintf(PETSC_COMM_WORLD, gi->relres_file, "%d,%e\n", num_iter, rel_res); CHKERRQ(ierr);
}
if (gi->verbose_level >= vl) {
ierr = PetscFPrintf(PETSC_COMM_WORLD, stdout, "\tnumiter: %d\trelres: %e\n", num_iter, rel_res); CHKERRQ(ierr);
}
/*
PetscInt axis, n;
for (axis = 0; axis < Naxis; ++axis) {
for (n = 0; n < gi->N[axis]; ++n) {
gi->d_dual[axis][n] *= gi->s_prim[axis][n];
gi->d_prim[axis][n] *= gi->s_dual[axis][n];
}
}
Mat DivE;
ierr = createDivE(&DivE, *gi); CHKERRQ(ierr);
Vec epsE0;
ierr = create_jSrc(&epsE0, *gi); CHKERRQ(ierr);
ierr = VecScale(epsE0, -1.0/PETSC_i/gi->omega); CHKERRQ(ierr);
Vec y;
ierr = VecDuplicate(gi->vecTemp, &y); CHKERRQ(ierr);
ierr = VecAYPX(epsE0, -1.0, x); CHKERRQ(ierr);
ierr = MatMult(DivE, epsE0, y);
PetscReal norm_x, norm_y;
ierr = VecNorm(x, NORM_INFINITY, &norm_x);
ierr = VecNorm(y, NORM_INFINITY, &norm_y);
ierr = PetscFPrintf(PETSC_COMM_WORLD, stdout, "\t%d\t\ttransversality: %e\n", num_iter, norm_y/norm_x); CHKERRQ(ierr);
//ierr = PetscFPrintf(PETSC_COMM_WORLD, stdout, "\t%d\t\ttransversality: %e\n", num_iter, norm_y); CHKERRQ(ierr);
for (axis = 0; axis < Naxis; ++axis) {
for (n = 0; n < gi->N[axis]; ++n) {
gi->d_dual[axis][n] /= gi->s_prim[axis][n];
gi->d_prim[axis][n] /= gi->s_dual[axis][n];
}
}
ierr = MatDestroy(DivE); CHKERRQ(ierr);
ierr = VecDestroy(y); CHKERRQ(ierr);
*/
PetscFunctionReturn(0);
}
/*@C
PetscObjectsDump - Prints the currently existing objects.
Logically Collective on PetscViewer
Input Parameter:
+ fd - file pointer
- all - by default only tries to display objects created explicitly by the user, if all is PETSC_TRUE then lists all outstanding objects
Options Database:
. -objects_dump <all>
Level: advanced
Concepts: options database^printing
@*/
PetscErrorCode PetscObjectsDump(FILE *fd,PetscBool all)
{
PetscErrorCode ierr;
PetscInt i;
#if defined(PETSC_USE_DEBUG)
PetscInt j,k=0;
#endif
PetscObject h;
PetscFunctionBegin;
if (PetscObjectsCounts) {
ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"The following objects were never freed\n");CHKERRQ(ierr);
ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"-----------------------------------------\n");CHKERRQ(ierr);
for (i=0; i<PetscObjectsMaxCounts; i++) {
if ((h = PetscObjects[i])) {
ierr = PetscObjectName(h);CHKERRQ(ierr);
{
#if defined(PETSC_USE_DEBUG)
PetscStack *stack = 0;
char *create,*rclass;
/* if the PETSc function the user calls is not a create then this object was NOT directly created by them */
ierr = PetscMallocGetStack(h,&stack);CHKERRQ(ierr);
if (stack) {
k = stack->currentsize-2;
if (!all) {
k = 0;
while (!stack->petscroutine[k]) k++;
ierr = PetscStrstr(stack->function[k],"Create",&create);CHKERRQ(ierr);
if (!create) {
ierr = PetscStrstr(stack->function[k],"Get",&create);CHKERRQ(ierr);
}
ierr = PetscStrstr(stack->function[k],h->class_name,&rclass);CHKERRQ(ierr);
if (!create) continue;
if (!rclass) continue;
}
}
#endif
ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"[%d] %s %s %s\n",PetscGlobalRank,h->class_name,h->type_name,h->name);CHKERRQ(ierr);
#if defined(PETSC_USE_DEBUG)
ierr = PetscMallocGetStack(h,&stack);CHKERRQ(ierr);
if (stack) {
for (j=k; j>=0; j--) {
fprintf(fd," [%d] %s() in %s\n",PetscGlobalRank,stack->function[j],stack->file[j]);
}
}
#endif
}
}
}
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscInitialize(&argc,&argv,(char *)0,0);
ierr = PetscFPrintf(PETSC_COMM_WORLD,stdout,"Demonstrates PETSc Error Handlers\n");CHKERRQ(ierr);
ierr = PetscFPrintf(PETSC_COMM_WORLD,stdout,"The error is a contrived error to test error handling\n");CHKERRQ(ierr);
ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD);CHKERRQ(ierr);
ierr = CreateError(5);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
PetscErrorCode PetscDrawClear_TikZ(PetscDraw draw)
{
PetscDraw_TikZ *win = (PetscDraw_TikZ*)draw->data;
PetscErrorCode ierr;
PetscFunctionBegin;
/* often PETSc generates unneeded clears, we want avoid creating empy pictures for them */
if (!win->written) PetscFunctionReturn(0);
ierr = PetscFPrintf(PetscObjectComm((PetscObject)draw),win->fd,TikZ_END_FRAME);CHKERRQ(ierr);
ierr = PetscFPrintf(PetscObjectComm((PetscObject)draw),win->fd,TikZ_BEGIN_FRAME);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PetscOpenHistoryFile(const char filename[],FILE **fd)
{
PetscErrorCode ierr;
PetscMPIInt rank,size;
char pfile[PETSC_MAX_PATH_LEN],pname[PETSC_MAX_PATH_LEN],fname[PETSC_MAX_PATH_LEN],date[64];
char version[256];
PetscFunctionBegin;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
CHKERRQ(ierr);
if (!rank) {
char arch[10];
int err;
ierr = PetscGetArchType(arch,10);
CHKERRQ(ierr);
ierr = PetscGetDate(date,64);
CHKERRQ(ierr);
ierr = PetscGetVersion(version,256);
CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);
CHKERRQ(ierr);
if (filename) {
ierr = PetscFixFilename(filename,fname);
CHKERRQ(ierr);
} else {
ierr = PetscGetHomeDirectory(pfile,240);
CHKERRQ(ierr);
ierr = PetscStrcat(pfile,"/.petschistory");
CHKERRQ(ierr);
ierr = PetscFixFilename(pfile,fname);
CHKERRQ(ierr);
}
*fd = fopen(fname,"a");
if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open file: %s",fname);
ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"---------------------------------------------------------\n");
CHKERRQ(ierr);
ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"%s %s\n",version,date);
CHKERRQ(ierr);
ierr = PetscGetProgramName(pname,PETSC_MAX_PATH_LEN);
CHKERRQ(ierr);
ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"%s on a %s, %d proc. with options:\n",pname,arch,size);
CHKERRQ(ierr);
ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"---------------------------------------------------------\n");
CHKERRQ(ierr);
err = fflush(*fd);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
}
PetscFunctionReturn(0);
}
PetscErrorCode PetscDrawDestroy_TikZ(PetscDraw draw)
{
PetscDraw_TikZ *win = (PetscDraw_TikZ*)draw->data;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscFPrintf(PetscObjectComm((PetscObject)draw),win->fd,TikZ_END_FRAME);CHKERRQ(ierr);
ierr = PetscFPrintf(PetscObjectComm((PetscObject)draw),win->fd,TikZ_END_DOCUMENT);CHKERRQ(ierr);
ierr = PetscFClose(PetscObjectComm((PetscObject)draw),win->fd);CHKERRQ(ierr);
ierr = PetscFree(win->filename);CHKERRQ(ierr);
ierr = PetscFree(win);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PetscDrawClear_TikZ(PetscDraw draw)
{
PetscDraw_TikZ *win = (PetscDraw_TikZ*)draw->data;
PetscBool written;
PetscErrorCode ierr;
PetscFunctionBegin;
/* often PETSc generates unneeded clears, we want avoid creating empy pictures for them */
ierr = MPI_Allreduce(&win->written,&written,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)(draw)));CHKERRQ(ierr);
if (!written) PetscFunctionReturn(0);
ierr = PetscFPrintf(PetscObjectComm((PetscObject)draw),win->fd,TikZ_END_FRAME);CHKERRQ(ierr);
ierr = PetscFPrintf(PetscObjectComm((PetscObject)draw),win->fd,TikZ_BEGIN_FRAME);CHKERRQ(ierr);
win->written = PETSC_FALSE;
PetscFunctionReturn(0);
}
PetscErrorCode PetscLogEventEndTrace(PetscLogEvent event,int t,PetscObject o1,PetscObject o2,PetscObject o3,PetscObject o4)
{
StageLog stageLog;
EventRegLog eventRegLog;
EventPerfLog eventPerfLog;
PetscLogDouble cur_time;
int stage,err;
PetscMPIInt rank;
PetscErrorCode ierr;
PetscFunctionBegin;
tracelevel--;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD, &rank);CHKERRQ(ierr);
ierr = PetscLogGetStageLog(&stageLog);CHKERRQ(ierr);
ierr = StageLogGetCurrent(stageLog, &stage);CHKERRQ(ierr);
ierr = StageLogGetEventRegLog(stageLog, &eventRegLog);CHKERRQ(ierr);
ierr = StageLogGetEventPerfLog(stageLog, stage, &eventPerfLog);CHKERRQ(ierr);
/* Check for double counting */
eventPerfLog->eventInfo[event].depth--;
if (eventPerfLog->eventInfo[event].depth > 0) {
PetscFunctionReturn(0);
} else if (eventPerfLog->eventInfo[event].depth < 0 || tracelevel < 0) {
SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "Logging event had unbalanced begin/end pairs");
}
/* Log performance info */
ierr = PetscStrncpy(tracespace, traceblanks, 2*tracelevel);CHKERRQ(ierr);
tracespace[2*tracelevel] = 0;
PetscTime(cur_time);
ierr = PetscFPrintf(PETSC_COMM_SELF,tracefile, "%s[%d] %g Event end: %s\n", tracespace, rank, cur_time-tracetime, eventRegLog->eventInfo[event].name);CHKERRQ(ierr);
err = fflush(tracefile);
if (err) SETERRQ(PETSC_ERR_SYS,"fflush() failed on file");
PetscFunctionReturn(0);
}
PetscErrorCode PetscLogEventBeginTrace(PetscLogEvent event, int t, PetscObject o1, PetscObject o2, PetscObject o3, PetscObject o4)
{
PetscStageLog stageLog;
PetscEventRegLog eventRegLog;
PetscEventPerfLog eventPerfLog = NULL;
PetscLogDouble cur_time;
PetscMPIInt rank;
int stage,err;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!petsc_tracetime) PetscTime(&petsc_tracetime);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD, &rank);CHKERRQ(ierr);
ierr = PetscLogGetStageLog(&stageLog);CHKERRQ(ierr);
ierr = PetscStageLogGetCurrent(stageLog, &stage);CHKERRQ(ierr);
ierr = PetscStageLogGetEventRegLog(stageLog, &eventRegLog);CHKERRQ(ierr);
ierr = PetscStageLogGetEventPerfLog(stageLog, stage, &eventPerfLog);CHKERRQ(ierr);
/* Check for double counting */
eventPerfLog->eventInfo[event].depth++;
petsc_tracelevel++;
if (eventPerfLog->eventInfo[event].depth > 1) PetscFunctionReturn(0);
/* Log performance info */
PetscTime(&cur_time);
ierr = PetscFPrintf(PETSC_COMM_SELF,petsc_tracefile, "%s[%d] %g Event begin: %s\n", petsc_tracespace, rank, cur_time-petsc_tracetime, eventRegLog->eventInfo[event].name);CHKERRQ(ierr);
ierr = PetscStrncpy(petsc_tracespace, petsc_traceblanks, 2*petsc_tracelevel);CHKERRQ(ierr);
petsc_tracespace[2*petsc_tracelevel] = 0;
err = fflush(petsc_tracefile);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
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 PetscViewerBinaryGetInfoPointer_Binary(PetscViewer viewer,FILE **file)
{
PetscViewer_Binary *vbinary = (PetscViewer_Binary*)viewer->data;
PetscErrorCode ierr;
MPI_Comm comm;
PetscFunctionBegin;
*file = vbinary->fdes_info;
if (viewer->format == PETSC_VIEWER_BINARY_MATLAB && !vbinary->matlabheaderwritten) {
vbinary->matlabheaderwritten = PETSC_TRUE;
ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
ierr = PetscFPrintf(comm,*file,"#--- begin code written by PetscViewerBinary for MATLAB format ---#\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm,*file,"#$$ Set.filename = '%s';\n",vbinary->filename);CHKERRQ(ierr);
ierr = PetscFPrintf(comm,*file,"#$$ fd = PetscOpenFile(Set.filename);\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm,*file,"#--- end code written by PetscViewerBinary for MATLAB format ---#\n\n");CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/**
* monitor_relres
* --------------
* Function to monitor the relative value of residual (= norm(r)/norm(b)).
*/
PetscErrorCode monitor_relres(KSP ksp, PetscInt n, PetscReal norm_r, void *ctx)
{
PetscFunctionBegin;
PetscErrorCode ierr;
MonitorCtx *monitor_ctx = (MonitorCtx *) ctx;
PetscReal norm_b = monitor_ctx->norm_b;
GridInfo *gi = monitor_ctx->gi;
PetscReal rel_res = norm_r/norm_b;
if (gi->output_relres) {
ierr = PetscFPrintf(PETSC_COMM_WORLD, gi->relres_file, "%d,%e\n", n, rel_res); CHKERRQ(ierr);
}
ierr = PetscFPrintf(PETSC_COMM_WORLD, stdout, "\tnumiter: %d\tnorm(r)/norm(b) = %e\n", n, rel_res); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
PetscViewerASCIIPrintf - Prints to a file, only from the first
processor in the PetscViewer
Not Collective, but only first processor in set has any effect
Input Parameters:
+ viewer - optained with PetscViewerASCIIOpen()
- format - the usual printf() format string
Level: developer
Fortran Note:
The call sequence is PetscViewerASCIIPrintf(PetscViewer, character(*), int ierr) from Fortran.
That is, you can only pass a single character string from Fortran.
Concepts: PetscViewerASCII^printing
Concepts: printing^to file
Concepts: printf
.seealso: PetscPrintf(), PetscSynchronizedPrintf(), PetscViewerASCIIOpen(),
PetscViewerASCIIPushTab(), PetscViewerASCIIPopTab(), PetscViewerASCIISynchronizedPrintf(),
PetscViewerCreate(), PetscViewerDestroy(), PetscViewerSetType(), PetscViewerASCIIGetPointer(), PetscViewerASCIISynchronizedAllow()
@*/
PetscErrorCode PetscViewerASCIIPrintf(PetscViewer viewer,const char format[],...)
{
PetscViewer_ASCII *ascii = (PetscViewer_ASCII*)viewer->data;
PetscMPIInt rank;
PetscInt tab;
PetscErrorCode ierr;
FILE *fd = ascii->fd;
PetscBool iascii;
int err;
PetscFunctionBegin;
PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,1);
PetscValidCharPointer(format,2);
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
if (!iascii) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Not ASCII PetscViewer");
ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)viewer),&rank);CHKERRQ(ierr);
if (!rank) {
va_list Argp;
if (ascii->bviewer) petsc_printfqueuefile = fd;
tab = ascii->tab;
while (tab--) {
ierr = PetscFPrintf(PETSC_COMM_SELF,fd," ");CHKERRQ(ierr);
}
va_start(Argp,format);
ierr = (*PetscVFPrintf)(fd,format,Argp);CHKERRQ(ierr);
err = fflush(fd);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
if (petsc_history) {
va_start(Argp,format);
tab = ascii->tab;
while (tab--) {
ierr = PetscFPrintf(PETSC_COMM_SELF,fd," ");CHKERRQ(ierr);
}
ierr = (*PetscVFPrintf)(petsc_history,format,Argp);CHKERRQ(ierr);
err = fflush(petsc_history);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
}
va_end(Argp);
}
PetscFunctionReturn(0);
}
/*@C
PetscFunctionListPrintTypes - Prints the methods available.
Collective over MPI_Comm
Input Parameters:
+ comm - the communicator (usually MPI_COMM_WORLD)
. fd - file to print to, usually stdout
. prefix - prefix to prepend to name (optional)
. name - option string (for example, "-ksp_type")
. text - short description of the object (for example, "Krylov solvers")
. man - name of manual page that discusses the object (for example, "KSPCreate")
. list - list of types
- def - default (current) value
Level: developer
.seealso: PetscFunctionListAdd(), PetscFunctionList
@*/
PetscErrorCode PetscFunctionListPrintTypes(MPI_Comm comm,FILE *fd,const char prefix[],const char name[],const char text[],const char man[],PetscFunctionList list,const char def[])
{
PetscErrorCode ierr;
char p[64];
PetscFunctionBegin;
if (!fd) fd = PETSC_STDOUT;
ierr = PetscStrncpy(p,"-",sizeof(p));CHKERRQ(ierr);
if (prefix) {ierr = PetscStrlcat(p,prefix,sizeof(p));CHKERRQ(ierr);}
ierr = PetscFPrintf(comm,fd," %s%s <%s>: %s (one of)",p,name+1,def,text);CHKERRQ(ierr);
while (list) {
ierr = PetscFPrintf(comm,fd," %s",list->name);CHKERRQ(ierr);
list = list->next;
}
ierr = PetscFPrintf(comm,fd," (%s)\n",man);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PetscDrawLine_TikZ(PetscDraw draw,PetscReal xl,PetscReal yl,PetscReal xr,PetscReal yr,int cl)
{
PetscDraw_TikZ *win = (PetscDraw_TikZ*)draw->data;
PetscErrorCode ierr;
PetscFunctionBegin;
win->written = PETSC_TRUE;
ierr = PetscFPrintf(PetscObjectComm((PetscObject)draw),win->fd,"\\draw [%s] (%g,%g) --(%g,%g);\n",TikZColorMap(cl),XTRANS(draw,xl),YTRANS(draw,yl),XTRANS(draw,xr),YTRANS(draw,yr));CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PetscDrawString_TikZ(PetscDraw draw,PetscReal xl,PetscReal yl,int cl,const char text[])
{
PetscDraw_TikZ *win = (PetscDraw_TikZ*)draw->data;
PetscErrorCode ierr;
PetscFunctionBegin;
win->written = PETSC_TRUE;
ierr = PetscFPrintf(PetscObjectComm((PetscObject)draw),win->fd,"\\node [above right, %s] at (%g,%g) {%s};\n",TikZColorMap(cl),XTRANS(draw,xl),YTRANS(draw,yl),text);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode DMPlexVTKWritePartition_ASCII(DM dm, FILE *fp)
{
MPI_Comm comm;
PetscInt numCells = 0, cellHeight;
PetscInt numLabelCells, cMax, cStart, cEnd, c;
PetscMPIInt numProcs, rank, proc, tag;
PetscBool hasLabel;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
ierr = PetscCommGetNewTag(comm, &tag);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &numProcs);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
ierr = DMPlexGetStratumSize(dm, "vtk", 1, &numLabelCells);CHKERRQ(ierr);
hasLabel = numLabelCells > 0 ? PETSC_TRUE : PETSC_FALSE;
for (c = cStart; c < cEnd; ++c) {
if (hasLabel) {
PetscInt value;
ierr = DMPlexGetLabelValue(dm, "vtk", c, &value);CHKERRQ(ierr);
if (value != 1) continue;
}
++numCells;
}
if (!rank) {
for (c = 0; c < numCells; ++c) {ierr = PetscFPrintf(comm, fp, "%d\n", rank);CHKERRQ(ierr);}
for (proc = 1; proc < numProcs; ++proc) {
MPI_Status status;
ierr = MPI_Recv(&numCells, 1, MPIU_INT, proc, tag, comm, &status);CHKERRQ(ierr);
for (c = 0; c < numCells; ++c) {ierr = PetscFPrintf(comm, fp, "%d\n", proc);CHKERRQ(ierr);}
}
} else {
ierr = MPI_Send(&numCells, 1, MPIU_INT, 0, tag, comm);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@
PetscSynchronizedFlush - Flushes to the screen output from all processors
involved in previous PetscSynchronizedPrintf() calls.
Collective on MPI_Comm
Input Parameters:
. comm - the communicator
Level: intermediate
Notes:
Usage of PetscSynchronizedPrintf() and PetscSynchronizedFPrintf() with
different MPI communicators REQUIRES an intervening call to PetscSynchronizedFlush().
.seealso: PetscSynchronizedPrintf(), PetscFPrintf(), PetscPrintf(), PetscViewerASCIIPrintf(),
PetscViewerASCIISynchronizedPrintf()
@*/
PetscErrorCode PetscSynchronizedFlush(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscMPIInt rank,size,tag,i,j,n,dummy = 0;
char *message;
MPI_Status status;
FILE *fd;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&comm,&tag);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
/* First processor waits for messages from all other processors */
if (!rank) {
if (petsc_printfqueuefile) {
fd = petsc_printfqueuefile;
} else {
fd = PETSC_STDOUT;
}
for (i=1; i<size; i++) {
/* to prevent a flood of messages to process zero, request each message separately */
ierr = MPI_Send(&dummy,1,MPI_INT,i,tag,comm);CHKERRQ(ierr);
ierr = MPI_Recv(&n,1,MPI_INT,i,tag,comm,&status);CHKERRQ(ierr);
for (j=0; j<n; j++) {
PetscMPIInt size;
ierr = MPI_Recv(&size,1,MPI_INT,i,tag,comm,&status);CHKERRQ(ierr);
ierr = PetscMalloc(size * sizeof(char), &message);CHKERRQ(ierr);
ierr = MPI_Recv(message,size,MPI_CHAR,i,tag,comm,&status);CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fd,"%s",message);
ierr = PetscFree(message);CHKERRQ(ierr);
}
}
petsc_printfqueuefile = PETSC_NULL;
} else { /* other processors send queue to processor 0 */
PrintfQueue next = petsc_printfqueuebase,previous;
ierr = MPI_Recv(&dummy,1,MPI_INT,0,tag,comm,&status);CHKERRQ(ierr);
ierr = MPI_Send(&petsc_printfqueuelength,1,MPI_INT,0,tag,comm);CHKERRQ(ierr);
for (i=0; i<petsc_printfqueuelength; i++) {
ierr = MPI_Send(&next->size,1,MPI_INT,0,tag,comm);CHKERRQ(ierr);
ierr = MPI_Send(next->string,next->size,MPI_CHAR,0,tag,comm);CHKERRQ(ierr);
previous = next;
next = next->next;
ierr = PetscFree(previous->string);CHKERRQ(ierr);
ierr = PetscFree(previous);CHKERRQ(ierr);
}
petsc_printfqueue = 0;
petsc_printfqueuelength = 0;
}
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PetscViewerDestroy_Binary(PetscViewer v)
{
PetscViewer_Binary *vbinary = (PetscViewer_Binary*)v->data;
PetscErrorCode ierr;
PetscFunctionBegin;
if (v->format == PETSC_VIEWER_BINARY_MATLAB) {
MPI_Comm comm;
FILE *info;
ierr = PetscObjectGetComm((PetscObject)v,&comm);CHKERRQ(ierr);
ierr = PetscViewerBinaryGetInfoPointer(v,&info);CHKERRQ(ierr);
ierr = PetscFPrintf(comm,info,"#--- begin code written by PetscViewerBinary for MATLAB format ---#\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm,info,"#$$ close(fd);\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm,info,"#--- end code written by PetscViewerBinary for MATLAB format ---#\n\n");CHKERRQ(ierr);
}
ierr = PetscViewerFileClose_Binary(v);CHKERRQ(ierr);
ierr = PetscFree(vbinary);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PetscDrawStringVertical_TikZ(PetscDraw draw,PetscReal xl,PetscReal yl,int cl,const char text[])
{
PetscDraw_TikZ *win = (PetscDraw_TikZ*)draw->data;
PetscErrorCode ierr;
size_t len;
PetscReal width;
PetscFunctionBegin;
win->written = PETSC_TRUE;
ierr = PetscStrlen(text,&len);CHKERRQ(ierr);
ierr = PetscDrawStringGetSize(draw,&width,NULL);CHKERRQ(ierr);
yl = yl - len*width*(draw->coor_yr - draw->coor_yl)/(draw->coor_xr - draw->coor_xl);
ierr = PetscFPrintf(PetscObjectComm((PetscObject)draw),win->fd,"\\node [rotate=90, %s] at (%g,%g) {%s};\n",TikZColorMap(cl),XTRANS(draw,xl),YTRANS(draw,yl),text);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Does not handle multiline strings correctly
*/
PetscErrorCode PetscDrawBoxedString_TikZ(PetscDraw draw,PetscReal xl,PetscReal yl,int cl,int ct,const char text[],PetscReal *w,PetscReal *h)
{
PetscDraw_TikZ *win = (PetscDraw_TikZ*)draw->data;
PetscErrorCode ierr;
size_t len;
PetscFunctionBegin;
win->written = PETSC_TRUE;
ierr = PetscFPrintf(PetscObjectComm((PetscObject)draw),win->fd,"\\draw (%g,%g) node [rectangle, draw, align=center, inner sep=1ex] {%s};\n",XTRANS(draw,xl),YTRANS(draw,yl),text);CHKERRQ(ierr);
/* make up totally bogus height and width of box */
ierr = PetscStrlen(text,&len);CHKERRQ(ierr);
if (w) *w = .07*len;
if (h) *h = .07;
PetscFunctionReturn(0);
}
/*MC
PetscInfo - Logs informative data, which is printed to standard output
or a file when the option -info <file> is specified.
Synopsis:
#include <petscsys.h>
PetscErrorCode PetscInfo(void *vobj, const char message[])
PetscErrorCode PetscInfo1(void *vobj, const char formatmessage[],arg1)
PetscErrorCode PetscInfo2(void *vobj, const char formatmessage[],arg1,arg2)
etc
Collective over PetscObject argument
Input Parameter:
+ vobj - object most closely associated with the logging statement or NULL
. message - logging message
- formatmessage - logging message using standard "printf" format
Options Database Key:
$ -info : activates printing of PetscInfo() messages
Level: intermediate
Fortran Note: This function does not take the vobj argument, there is only the PetscInfo()
version, not PetscInfo1() etc.
Example of Usage:
$
$ Mat A
$ double alpha
$ PetscInfo1(A,"Matrix uses parameter alpha=%g\n",alpha);
$
Concepts: runtime information
.seealso: PetscInfoAllow()
M*/
PetscErrorCode PetscInfo_Private(const char func[],void *vobj, const char message[], ...)
{
va_list Argp;
PetscMPIInt rank,urank;
size_t len;
PetscObject obj = (PetscObject)vobj;
char string[8*1024];
PetscErrorCode ierr;
size_t fullLength;
int err;
PetscFunctionBegin;
if (obj) PetscValidHeader(obj,1);
PetscValidCharPointer(message,2);
if (!PetscLogPrintInfo) PetscFunctionReturn(0);
if ((!PetscLogPrintInfoNull) && !vobj) PetscFunctionReturn(0);
if (obj && !PetscInfoFlags[obj->classid - PETSC_SMALLEST_CLASSID - 1]) PetscFunctionReturn(0);
if (!obj) rank = 0;
else {
ierr = MPI_Comm_rank(obj->comm, &rank);
CHKERRQ(ierr);
}
if (rank) PetscFunctionReturn(0);
ierr = MPI_Comm_rank(MPI_COMM_WORLD, &urank);
CHKERRQ(ierr);
va_start(Argp, message);
sprintf(string, "[%d] %s(): ", urank,func);
ierr = PetscStrlen(string, &len);
CHKERRQ(ierr);
ierr = PetscVSNPrintf(string+len, 8*1024-len,message,&fullLength, Argp);
CHKERRQ(ierr);
ierr = PetscFPrintf(PETSC_COMM_SELF,PetscInfoFile, "%s", string);
CHKERRQ(ierr);
err = fflush(PetscInfoFile);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
if (petsc_history) {
va_start(Argp, message);
ierr = (*PetscVFPrintf)(petsc_history, message, Argp);
CHKERRQ(ierr);
}
va_end(Argp);
PetscFunctionReturn(0);
}
/*@C
PetscViewerVUFlushDeferred - Flushes the deferred write cache to the file.
Not Collective
Input Parameter:
+ viewer - The PetscViewer
Level: intermediate
.keywords: Viewer, flush, deferred
.seealso: PetscViewerVUPrintDeferred()
@*/
PetscErrorCode PetscViewerVUFlushDeferred(PetscViewer viewer)
{
PetscViewer_VU *vu = (PetscViewer_VU*) viewer->data;
PrintfQueue next = vu->queueBase;
PrintfQueue previous;
int i;
PetscErrorCode ierr;
PetscFunctionBegin;
for (i = 0; i < vu->queueLength; i++) {
PetscFPrintf(PetscObjectComm((PetscObject)viewer), vu->fd, "%s", next->string);
previous = next;
next = next->next;
ierr = PetscFree(previous);CHKERRQ(ierr);
}
vu->queue = NULL;
vu->queueLength = 0;
PetscFunctionReturn(0);
}
PetscErrorCode monitorRelerr(const VerboseLevel vl, const Vec x, const Vec right_precond, const PetscInt num_iter, const PetscReal rel_res, const Mat CF, const Vec conjParam, const Vec conjSrc, GridInfo *gi)
{
PetscFunctionBegin;
PetscErrorCode ierr;
if (gi->verbose_level >= vl && gi->has_xref) {
Vec dx = gi->vecTemp;
ierr = VecPointwiseDivide(dx, x, right_precond); CHKERRQ(ierr);
ierr = VecAXPY(dx, -1.0, gi->xref); CHKERRQ(ierr);
PetscReal norm_dx;
ierr = VecNorm(dx, NORM_INFINITY, &norm_dx); CHKERRQ(ierr);
PetscReal rel_err = norm_dx / gi->norm_xref;
ierr = PetscFPrintf(PETSC_COMM_WORLD, stdout, "\t%d\t\trelres: %e, \trelerr: %e\n", num_iter, rel_res, rel_err); CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode monitorSnapshot(const VerboseLevel vl, const Vec x, const Vec right_precond, const PetscInt num_iter, const PetscReal rel_res, const Mat CF, const Vec conjParam, const Vec conjSrc, GridInfo *gi)
{
PetscFunctionBegin;
PetscErrorCode ierr;
char snapshot_name[PETSC_MAX_PATH_LEN];
char num_iter_str[PETSC_MAX_PATH_LEN];
Vec x_snapshot = gi->vecTemp;
if (gi->verbose_level >= vl && gi->snapshot_interval > 0 && num_iter >= 0 && num_iter % gi->snapshot_interval == 0) {
ierr = PetscStrcpy(snapshot_name, gi->output_name); CHKERRQ(ierr);
ierr = PetscStrcat(snapshot_name, "."); CHKERRQ(ierr);
//sprintf(num_iter_str, "%d", num_iter);
ierr = PetscFPrintf(PETSC_COMM_WORLD, stdout, "%d", num_iter); CHKERRQ(ierr);
ierr = PetscStrcat(snapshot_name, num_iter_str); CHKERRQ(ierr);
ierr = VecCopy(x, x_snapshot); CHKERRQ(ierr);
ierr = VecPointwiseDivide(x_snapshot, x_snapshot, right_precond); CHKERRQ(ierr);
ierr = output(snapshot_name, x_snapshot, CF, conjParam, conjSrc, *gi); CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode DMDAVTKWriteAll_VTS(DM da,PetscViewer viewer)
{
#if defined(PETSC_USE_REAL_SINGLE)
const char precision[] = "Float32";
#elif defined(PETSC_USE_REAL_DOUBLE)
const char precision[] = "Float64";
#else
const char precision[] = "UnknownPrecision";
#endif
MPI_Comm comm = ((PetscObject)da)->comm;
PetscViewer_VTK *vtk = (PetscViewer_VTK*)viewer->data;
PetscViewerVTKObjectLink link;
FILE *fp;
PetscMPIInt rank,size,tag;
DMDALocalInfo info;
PetscInt dim,mx,my,mz,bs,boffset,maxnnodes,i,j,k,f,r;
PetscInt rloc[6],(*grloc)[6] = PETSC_NULL;
PetscScalar *array,*array2;
PetscReal gmin[3],gmax[3];
PetscErrorCode ierr;
PetscFunctionBegin;
#if defined(PETSC_USE_COMPLEX)
SETERRQ(comm,PETSC_ERR_SUP,"Complex values not supported");
#endif
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,&dim, &mx,&my,&mz, 0,0,0, &bs,0,0,0,0,0);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(da,&info);CHKERRQ(ierr);
ierr = DMDAGetBoundingBox(da,gmin,gmax);CHKERRQ(ierr);
ierr = PetscFOpen(comm,vtk->filename,"wb",&fp);CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fp,"<?xml version=\"1.0\"?>\n");CHKERRQ(ierr);
#ifdef PETSC_WORDS_BIGENDIAN
ierr = PetscFPrintf(comm,fp,"<VTKFile type=\"StructuredGrid\" version=\"0.1\" byte_order=\"BigEndian\">\n");CHKERRQ(ierr);
#else
ierr = PetscFPrintf(comm,fp,"<VTKFile type=\"StructuredGrid\" version=\"0.1\" byte_order=\"LittleEndian\">\n");CHKERRQ(ierr);
#endif
ierr = PetscFPrintf(comm,fp," <StructuredGrid WholeExtent=\"%D %D %D %D %D %D\">\n",0,mx-1,0,my-1,0,mz-1);CHKERRQ(ierr);
if (!rank) {ierr = PetscMalloc(size*6*sizeof(PetscInt),&grloc);CHKERRQ(ierr);}
rloc[0] = info.xs;
rloc[1] = info.xm;
rloc[2] = info.ys;
rloc[3] = info.ym;
rloc[4] = info.zs;
rloc[5] = info.zm;
ierr = MPI_Gather(rloc,6,MPIU_INT,&grloc[0][0],6,MPIU_INT,0,comm);CHKERRQ(ierr);
/* Write XML header */
maxnnodes = 0; /* Used for the temporary array size on rank 0 */
boffset = 0; /* Offset into binary file */
for (r=0; r<size; r++) {
PetscInt xs=-1,xm=-1,ys=-1,ym=-1,zs=-1,zm=-1,nnodes = 0;
if (!rank) {
xs = grloc[r][0];
xm = grloc[r][1];
ys = grloc[r][2];
ym = grloc[r][3];
zs = grloc[r][4];
zm = grloc[r][5];
nnodes = xm*ym*zm;
}
maxnnodes = PetscMax(maxnnodes,nnodes);
#if 0
switch (dim) {
case 1:
ierr = PetscFPrintf(comm,fp," <Piece Extent=\"%D %D %D %D %D %D\">\n",xs,xs+xm-1,0,0,0,0);CHKERRQ(ierr);
break;
case 2:
ierr = PetscFPrintf(comm,fp," <Piece Extent=\"%D %D %D %D %D %D\">\n",xs,xs+xm,ys+ym-1,xs,xs+xm-1,0,0);CHKERRQ(ierr);
break;
case 3:
ierr = PetscFPrintf(comm,fp," <Piece Extent=\"%D %D %D %D %D %D\">\n",xs,xs+xm-1,ys,ys+ym-1,zs,zs+zm-1);CHKERRQ(ierr);
break;
default: SETERRQ1(((PetscObject)da)->comm,PETSC_ERR_SUP,"No support for dimension %D",dim);
}
#endif
ierr = PetscFPrintf(comm,fp," <Piece Extent=\"%D %D %D %D %D %D\">\n",xs,xs+xm-1,ys,ys+ym-1,zs,zs+zm-1);CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fp," <Points>\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fp," <DataArray type=\"%s\" Name=\"Position\" NumberOfComponents=\"3\" format=\"appended\" offset=\"%D\" />\n",precision,boffset);CHKERRQ(ierr);
boffset += 3*nnodes*sizeof(PetscScalar) + sizeof(int);
ierr = PetscFPrintf(comm,fp," </Points>\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fp," <PointData Scalars=\"ScalarPointData\">\n");CHKERRQ(ierr);
for (link=vtk->link; link; link=link->next) {
Vec X = (Vec)link->vec;
const char *vecname = "";
if (((PetscObject)X)->name || link != vtk->link) { /* If the object is already named, use it. If it is past the first link, name it to disambiguate. */
ierr = PetscObjectGetName((PetscObject)X,&vecname);CHKERRQ(ierr);
}
for (i=0; i<bs; i++) {
char buf[256];
const char *fieldname;
ierr = DMDAGetFieldName(da,i,&fieldname);CHKERRQ(ierr);
if (!fieldname) {
ierr = PetscSNPrintf(buf,sizeof(buf),"Unnamed%D",i);CHKERRQ(ierr);
fieldname = buf;
}
ierr = PetscFPrintf(comm,fp," <DataArray type=\"%s\" Name=\"%s%s\" NumberOfComponents=\"1\" format=\"appended\" offset=\"%D\" />\n",precision,vecname,fieldname,boffset);CHKERRQ(ierr);
boffset += nnodes*sizeof(PetscScalar) + sizeof(int);
}
}
ierr = PetscFPrintf(comm,fp," </PointData>\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fp," </Piece>\n");CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm,fp," </StructuredGrid>\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fp," <AppendedData encoding=\"raw\">\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fp,"_");CHKERRQ(ierr);
/* Now write the arrays. */
tag = ((PetscObject)viewer)->tag;
ierr = PetscMalloc2(maxnnodes*PetscMax(3,bs),PetscScalar,&array,maxnnodes*3,PetscScalar,&array2);CHKERRQ(ierr);
for (r=0; r<size; r++) {
MPI_Status status;
PetscInt xs=-1,xm=-1,ys=-1,ym=-1,zs=-1,zm=-1,nnodes = 0;
if (!rank) {
xs = grloc[r][0];
xm = grloc[r][1];
ys = grloc[r][2];
ym = grloc[r][3];
zs = grloc[r][4];
zm = grloc[r][5];
nnodes = xm*ym*zm;
} else if (r == rank) {
nnodes = info.xm*info.ym*info.zm;
}
{ /* Write the coordinates */
Vec Coords;
ierr = DMGetCoordinates(da,&Coords);CHKERRQ(ierr);
if (Coords) {
const PetscScalar *coords;
ierr = VecGetArrayRead(Coords,&coords);CHKERRQ(ierr);
if (!rank) {
if (r) {
PetscMPIInt nn;
ierr = MPI_Recv(array,nnodes*dim,MPIU_SCALAR,r,tag,comm,&status);CHKERRQ(ierr);
ierr = MPI_Get_count(&status,MPIU_SCALAR,&nn);CHKERRQ(ierr);
if (nn != nnodes*dim) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Array size mismatch");
} else {
ierr = PetscMemcpy(array,coords,nnodes*dim*sizeof(PetscScalar));CHKERRQ(ierr);
}
/* Transpose coordinates to VTK (C-style) ordering */
for (k=0; k<zm; k++) {
for (j=0; j<ym; j++) {
for (i=0; i<xm; i++) {
PetscInt Iloc = i+xm*(j+ym*k);
array2[Iloc*3+0] = array[Iloc*dim + 0];
array2[Iloc*3+1] = dim > 1 ? array[Iloc*dim + 1] : 0;
array2[Iloc*3+2] = dim > 2 ? array[Iloc*dim + 2] : 0;
}
}
}
} else if (r == rank) {
ierr = MPI_Send((void*)coords,nnodes*dim,MPIU_SCALAR,0,tag,comm);CHKERRQ(ierr);
}
ierr = VecRestoreArrayRead(Coords,&coords);CHKERRQ(ierr);
} else { /* Fabricate some coordinates using grid index */
for (k=0; k<zm; k++) {
for (j=0; j<ym; j++) {
for (i=0; i<xm; i++) {
PetscInt Iloc = i+xm*(j+ym*k);
array2[Iloc*3+0] = xs+i;
array2[Iloc*3+1] = ys+j;
array2[Iloc*3+2] = zs+k;
}
}
}
}
ierr = PetscViewerVTKFWrite(viewer,fp,array2,nnodes*3,PETSC_SCALAR);CHKERRQ(ierr);
}
/* Write each of the objects queued up for this file */
for (link=vtk->link; link; link=link->next) {
Vec X = (Vec)link->vec;
const PetscScalar *x;
ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
if (!rank) {
if (r) {
PetscMPIInt nn;
ierr = MPI_Recv(array,nnodes*bs,MPIU_SCALAR,r,tag,comm,&status);CHKERRQ(ierr);
ierr = MPI_Get_count(&status,MPIU_SCALAR,&nn);CHKERRQ(ierr);
if (nn != nnodes*bs) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Array size mismatch receiving from rank %D",r);
} else {
ierr = PetscMemcpy(array,x,nnodes*bs*sizeof(PetscScalar));CHKERRQ(ierr);
}
for (f=0; f<bs; f++) {
/* Extract and transpose the f'th field */
for (k=0; k<zm; k++) {
for (j=0; j<ym; j++) {
for (i=0; i<xm; i++) {
PetscInt Iloc = i+xm*(j+ym*k);
array2[Iloc] = array[Iloc*bs + f];
}
}
}
ierr = PetscViewerVTKFWrite(viewer,fp,array2,nnodes,PETSC_SCALAR);CHKERRQ(ierr);
}
} else if (r == rank) {
ierr = MPI_Send((void*)x,nnodes*bs,MPIU_SCALAR,0,tag,comm);CHKERRQ(ierr);
}
ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
}
}
ierr = PetscFree2(array,array2);CHKERRQ(ierr);
ierr = PetscFree(grloc);CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fp,"\n </AppendedData>\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fp,"</VTKFile>\n");CHKERRQ(ierr);
ierr = PetscFClose(comm,fp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec U; /* solution will be stored here */
Mat A; /* Jacobian matrix */
Mat Ap; /* dfdp */
PetscErrorCode ierr;
PetscMPIInt size;
PetscInt n = 2;
PetscScalar *u,*v;
AppCtx app;
PetscInt direction[1];
PetscBool terminate[1];
Vec lambda[2],mu[2];
PetscReal tend;
FILE *f;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs");
app.mode = 1;
app.lambda1 = 2.75;
app.lambda2 = 0.36;
tend = 0.125;
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"ex1adj options","");CHKERRQ(ierr);
{
ierr = PetscOptionsReal("-lambda1","","",app.lambda1,&app.lambda1,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-lambda2","","",app.lambda2,&app.lambda2,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-tend","","",tend,&tend,NULL);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&U,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&Ap);CHKERRQ(ierr);
ierr = MatSetSizes(Ap,n,1,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetType(Ap,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(Ap);CHKERRQ(ierr);
ierr = MatSetUp(Ap);CHKERRQ(ierr);
ierr = MatZeroEntries(Ap);CHKERRQ(ierr); /* initialize to zeros */
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = 0;
u[1] = 1;
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSCN);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,(TSIFunction)IFunction,&app);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,A,A,(TSIJacobian)IJacobian,&app);CHKERRQ(ierr);
ierr = TSSetRHSJacobianP(ts,Ap,RHSJacobianP,&app);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSolution(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Save trajectory of solution so that TSAdjointSolve() may be used
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetMaxTime(ts,tend);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,1./256.);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* Set directions and terminate flags for the two events */
direction[0] = 0;
terminate[0] = PETSC_FALSE;
ierr = TSSetEventHandler(ts,1,direction,terminate,EventFunction,PostEventFunction,(void*)&app);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Run timestepping solver
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Adjoint model starts here
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreateVecs(A,&lambda[0],NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&lambda[1],NULL);CHKERRQ(ierr);
/* Set initial conditions for the adjoint integration */
ierr = VecZeroEntries(lambda[0]);CHKERRQ(ierr);
ierr = VecZeroEntries(lambda[1]);CHKERRQ(ierr);
ierr = VecGetArray(lambda[0],&u);CHKERRQ(ierr);
u[0] = 1.;
ierr = VecRestoreArray(lambda[0],&u);CHKERRQ(ierr);
ierr = VecGetArray(lambda[1],&u);CHKERRQ(ierr);
u[1] = 1.;
ierr = VecRestoreArray(lambda[1],&u);CHKERRQ(ierr);
ierr = MatCreateVecs(Ap,&mu[0],NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(Ap,&mu[1],NULL);CHKERRQ(ierr);
ierr = VecZeroEntries(mu[0]);CHKERRQ(ierr);
ierr = VecZeroEntries(mu[1]);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,2,lambda,mu);CHKERRQ(ierr);
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
/*
ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(lambda[1],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(mu[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(mu[1],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
*/
ierr = VecGetArray(mu[0],&u);CHKERRQ(ierr);
ierr = VecGetArray(mu[1],&v);CHKERRQ(ierr);
f = fopen("adj_mu.out", "a");
ierr = PetscFPrintf(PETSC_COMM_WORLD,f,"%20.15lf %20.15lf %20.15lf\n",tend,u[0],v[0]);CHKERRQ(ierr);
ierr = VecRestoreArray(mu[0],&u);CHKERRQ(ierr);
ierr = VecRestoreArray(mu[1],&v);CHKERRQ(ierr);
fclose(f);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&U);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = MatDestroy(&Ap);CHKERRQ(ierr);
ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);
ierr = VecDestroy(&lambda[1]);CHKERRQ(ierr);
ierr = VecDestroy(&mu[0]);CHKERRQ(ierr);
ierr = VecDestroy(&mu[1]);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
