/*@C
PETSC_VIEWER_BINARY_ - Creates a binary PetscViewer shared by all processors
in a communicator.
Collective on MPI_Comm
Input Parameter:
. comm - the MPI communicator to share the binary PetscViewer
Level: intermediate
Options Database Keys:
+ -viewer_binary_filename <name>
. -viewer_binary_skip_info
- -viewer_binary_skip_options
Environmental variables:
- PETSC_VIEWER_BINARY_FILENAME
Notes:
Unlike almost all other PETSc routines, PETSC_VIEWER_BINARY_ does not return
an error code. The binary PetscViewer is usually used in the form
$ XXXView(XXX object,PETSC_VIEWER_BINARY_(comm));
.seealso: PETSC_VIEWER_BINARY_WORLD, PETSC_VIEWER_BINARY_SELF, PetscViewerBinaryOpen(), PetscViewerCreate(),
PetscViewerDestroy()
@*/
PetscViewer PETSC_VIEWER_BINARY_(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscBool flg;
PetscViewer viewer;
char fname[PETSC_MAX_PATH_LEN];
MPI_Comm ncomm;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&ncomm,NULL);if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (Petsc_Viewer_Binary_keyval == MPI_KEYVAL_INVALID) {
ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,MPI_NULL_DELETE_FN,&Petsc_Viewer_Binary_keyval,0);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = MPI_Attr_get(ncomm,Petsc_Viewer_Binary_keyval,(void**)&viewer,(int*)&flg);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (!flg) { /* PetscViewer not yet created */
ierr = PetscOptionsGetenv(ncomm,"PETSC_VIEWER_BINARY_FILENAME",fname,PETSC_MAX_PATH_LEN,&flg);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (!flg) {
ierr = PetscStrcpy(fname,"binaryoutput");
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = PetscViewerBinaryOpen(ncomm,fname,FILE_MODE_WRITE,&viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = PetscObjectRegisterDestroy((PetscObject)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = MPI_Attr_put(ncomm,Petsc_Viewer_Binary_keyval,(void*)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = PetscCommDestroy(&ncomm);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_BINARY_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
PetscFunctionReturn(viewer);
}
/*
This is used by MPIU_Allreduce() to insure that all callers originated from the same place in the PETSc code
*/
PetscErrorCode PetscAllreduceBarrierCheck(MPI_Comm comm,PetscMPIInt ctn,int line,const char *func,const char *file)
{
PetscMPIInt err;
PetscMPIInt b1[6],b2[6];
b1[0] = -(PetscMPIInt)line; b1[1] = -b1[0];
b1[2] = -(PetscMPIInt)hash(func); b1[3] = -b1[2];
b1[4] = -(PetscMPIInt)ctn; b1[5] = -b1[4];
err = MPI_Allreduce(b1,b2,6,MPI_INT,MPI_MAX,comm);
if (err) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"MPI_Allreduced() failed");
if (-b2[0] != b2[1]) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"MPI_Allreduce() called in different locations (code lines) on different processors");
if (-b2[2] != b2[3]) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"MPI_Allreduce() called in different locations (functions) on different processors");
if (-b2[4] != b2[5]) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"MPI_Allreduce() called with different counts %d on different processors",ctn);
return 0;
}
PetscErrorCode PetscMallocAlign(size_t mem,int line,const char func[],const char file[],void **result)
{
if (!mem) { *result = NULL; return 0; }
#if defined(PETSC_HAVE_DOUBLE_ALIGN_MALLOC) && (PETSC_MEMALIGN == 8)
*result = malloc(mem);
#elif defined(PETSC_HAVE_MEMALIGN)
*result = memalign(PETSC_MEMALIGN,mem);
#else
{
/*
malloc space for two extra chunks and shift ptr 1 + enough to get it PetscScalar aligned
*/
int *ptr = (int*)malloc(mem + 2*PETSC_MEMALIGN);
if (ptr) {
int shift = (int)(((PETSC_UINTPTR_T) ptr) % PETSC_MEMALIGN);
shift = (2*PETSC_MEMALIGN - shift)/sizeof(int);
ptr[shift-1] = shift + SHIFT_CLASSID;
ptr += shift;
*result = (void*)ptr;
} else {
*result = NULL;
}
}
#endif
if (!*result) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_MEM,PETSC_ERROR_INITIAL,"Memory requested %.0f",(PetscLogDouble)mem);
return 0;
}
/*@C
PETSC_VIEWER_SOCKET_ - Creates a socket viewer shared by all processors in a communicator.
Collective on MPI_Comm
Input Parameter:
. comm - the MPI communicator to share the socket PetscViewer
Level: intermediate
Options Database Keys:
For use with the default PETSC_VIEWER_SOCKET_WORLD or if
NULL is passed for machine or PETSC_DEFAULT is passed for port
$ -viewer_socket_machine <machine>
$ -viewer_socket_port <port>
Environmental variables:
+ PETSC_VIEWER_SOCKET_PORT portnumber
- PETSC_VIEWER_SOCKET_MACHINE machine name
Notes:
Unlike almost all other PETSc routines, PetscViewer_SOCKET_ does not return
an error code. The socket PetscViewer is usually used in the form
$ XXXView(XXX object,PETSC_VIEWER_SOCKET_(comm));
Currently the only socket client available is MATLAB. See
src/dm/examples/tests/ex12.c and ex12.m for an example of usage.
Connects to a waiting socket and stays connected until PetscViewerDestroy() is called.
Use this for communicating with an interactive MATLAB session, see PETSC_VIEWER_MATLAB_() for writing output to a
.mat file. Use PetscMatlabEngineCreate() or PETSC_MATLAB_ENGINE_(), PETSC_MATLAB_ENGINE_SELF, or PETSC_MATLAB_ENGINE_WORLD
for communicating with a MATLAB Engine
.seealso: PETSC_VIEWER_SOCKET_WORLD, PETSC_VIEWER_SOCKET_SELF, PetscViewerSocketOpen(), PetscViewerCreate(),
PetscViewerSocketSetConnection(), PetscViewerDestroy(), PETSC_VIEWER_SOCKET_(), PetscViewerBinaryWrite(), PetscViewerBinaryRead(),
PetscViewerBinaryWriteStringArray(), PetscViewerBinaryGetDescriptor(), PETSC_VIEWER_MATLAB_()
@*/
PetscViewer PETSC_VIEWER_SOCKET_(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscBool flg;
PetscViewer viewer;
MPI_Comm ncomm;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&ncomm,NULL);if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (Petsc_Viewer_Socket_keyval == MPI_KEYVAL_INVALID) {
ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,MPI_COMM_NULL_DELETE_FN,&Petsc_Viewer_Socket_keyval,0);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = MPI_Comm_get_attr(ncomm,Petsc_Viewer_Socket_keyval,(void**)&viewer,(int*)&flg);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (!flg) { /* PetscViewer not yet created */
ierr = PetscViewerSocketOpen(ncomm,0,0,&viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = PetscObjectRegisterDestroy((PetscObject)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = MPI_Comm_set_attr(ncomm,Petsc_Viewer_Socket_keyval,(void*)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = PetscCommDestroy(&ncomm);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
PetscFunctionReturn(viewer);
}
/*@C
PETSC_VIEWER_DRAW_ - Creates a window PetscViewer shared by all processors
in a communicator.
Collective on MPI_Comm
Input Parameter:
. comm - the MPI communicator to share the window PetscViewer
Level: intermediate
Notes:
Unlike almost all other PETSc routines, PETSC_VIEWER_DRAW_ does not return
an error code. The window is usually used in the form
$ XXXView(XXX object,PETSC_VIEWER_DRAW_(comm));
.seealso: PETSC_VIEWER_DRAW_WORLD, PETSC_VIEWER_DRAW_SELF, PetscViewerDrawOpen(),
@*/
PetscViewer PETSC_VIEWER_DRAW_(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscMPIInt flag;
PetscViewer viewer;
MPI_Comm ncomm;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&ncomm,NULL);if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (Petsc_Viewer_Draw_keyval == MPI_KEYVAL_INVALID) {
ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,MPI_NULL_DELETE_FN,&Petsc_Viewer_Draw_keyval,0);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = MPI_Attr_get(ncomm,Petsc_Viewer_Draw_keyval,(void**)&viewer,&flag);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
if (!flag) { /* PetscViewer not yet created */
ierr = PetscViewerDrawOpen(ncomm,0,0,PETSC_DECIDE,PETSC_DECIDE,300,300,&viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = PetscObjectRegisterDestroy((PetscObject)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
ierr = MPI_Attr_put(ncomm,Petsc_Viewer_Draw_keyval,(void*)viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
}
ierr = PetscCommDestroy(&ncomm);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," ");PetscFunctionReturn(0);}
PetscFunctionReturn(viewer);
}
PetscErrorCode PetscFreeDefault(void *ptr,int line,char *func,char *file)
{
#if defined(PETSC_HAVE_FREE_RETURN_INT)
int err = free(ptr);
if (err) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"System free returned error %d\n",err);
#else
free(ptr);
#endif
return 0;
}
void Error::sendtopetsc()
{
PetscError(PETSC_COMM_SELF,
line,
func.c_str(),
file.c_str(),
code,
(ini ? PETSC_ERROR_INITIAL : PETSC_ERROR_REPEAT),
mess.str().c_str() );
}
/*@C
PETSC_VIEWER_STDOUT_ - Creates a ASCII PetscViewer shared by all processors
in a communicator.
Collective on MPI_Comm
Input Parameter:
. comm - the MPI communicator to share the PetscViewer
Level: beginner
Notes:
Unlike almost all other PETSc routines, this does not return
an error code. Usually used in the form
$ XXXView(XXX object,PETSC_VIEWER_STDOUT_(comm));
.seealso: PETSC_VIEWER_DRAW_(), PetscViewerASCIIOpen(), PETSC_VIEWER_STDERR_, PETSC_VIEWER_STDOUT_WORLD,
PETSC_VIEWER_STDOUT_SELF
@*/
PetscViewer PETSC_VIEWER_STDOUT_(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscViewer viewer;
PetscFunctionBegin;
ierr = PetscViewerASCIIGetStdout(comm,&viewer);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_VIEWER_STDOUT_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," "); PetscFunctionReturn(0);}
PetscFunctionReturn(viewer);
}
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "PetscDefaultFPTrap"
void PetscDefaultFPTrap(int sig)
{
PetscFunctionBegin;
(*PetscErrorPrintf)("*** floating point error occurred ***\n");
PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
MPI_Abort(PETSC_COMM_WORLD,0);
}
PetscErrorCode PETSC_DLLEXPORT PetscFreeDefault(void *ptr,int line,char *func,char *file,char *dir)
{
#if defined(PETSC_HAVE_FREE_RETURN_INT)
int err = free(ptr);
if (err) {
return PetscError(line,func,file,dir,1,1,"System free returned error %d\n",err);
}
#else
free(ptr);
#endif
return 0;
}
/*@C
PETSC_MATLAB_ENGINE_ - Creates a matlab engine shared by all processors
in a communicator.
Not Collective
Input Parameter:
. comm - the MPI communicator to share the engine
Level: developer
Notes:
Unlike almost all other PETSc routines, this does not return
an error code. Usually used in the form
$ PetscMatlabEngineYYY(XXX object,PETSC_MATLAB_ENGINE_(comm));
.seealso: PetscMatlabEngineDestroy(), PetscMatlabEnginePut(), PetscMatlabEngineGet(),
PetscMatlabEngineEvaluate(), PetscMatlabEngineGetOutput(), PetscMatlabEnginePrintOutput(),
PetscMatlabEngineCreate(), PetscMatlabEnginePutArray(), PetscMatlabEngineGetArray(), PetscMatlabEngine,
PETSC_MATLAB_ENGINE_WORLD, PETSC_MATLAB_ENGINE_SELF
@*/
PetscMatlabEngine PETSC_MATLAB_ENGINE_(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscBool flg;
PetscMatlabEngine mengine;
PetscFunctionBegin;
if (Petsc_Matlab_Engine_keyval == MPI_KEYVAL_INVALID) {
ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,MPI_NULL_DELETE_FN,&Petsc_Matlab_Engine_keyval,0);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_MATLAB_ENGINE_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," "); mengine = 0;}
}
ierr = MPI_Attr_get(comm,Petsc_Matlab_Engine_keyval,(void**)&mengine,(int*)&flg);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_MATLAB_ENGINE_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," "); mengine = 0;}
if (!flg) { /* viewer not yet created */
char *machinename = 0,machine[64];
ierr = PetscOptionsGetString(NULL,NULL,"-matlab_engine_machine",machine,64,&flg);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_MATLAB_ENGINE_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," "); mengine = 0;}
if (flg) machinename = machine;
ierr = PetscMatlabEngineCreate(comm,machinename,&mengine);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_MATLAB_ENGINE_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," "); mengine = 0;}
ierr = PetscObjectRegisterDestroy((PetscObject)mengine);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_MATLAB_ENGINE_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," "); mengine = 0;}
ierr = MPI_Attr_put(comm,Petsc_Matlab_Engine_keyval,mengine);
if (ierr) {PetscError(PETSC_COMM_SELF,__LINE__,"PETSC_MATLAB_ENGINE_",__FILE__,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL," "); mengine = 0;}
}
PetscFunctionReturn(mengine);
}
PetscErrorCode PetscFreeAlign(void *ptr,int line,const char func[],const char file[])
{
#if (!(defined(PETSC_HAVE_DOUBLE_ALIGN_MALLOC) && (PETSC_MEMALIGN == 8)) && !defined(PETSC_HAVE_MEMALIGN))
int shift;
/*
Previous int tells us how many ints the pointer has been shifted from
the original address provided by the system malloc().
*/
shift = *(((int*)ptr)-1) - SHIFT_CLASSID;
if (shift > PETSC_MEMALIGN-1) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"Likely memory corruption in heap");
if (shift < 0) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"Likely memory corruption in heap");
ptr = (void*)(((int*)ptr) - shift);
#endif
#if defined(PETSC_HAVE_FREE_RETURN_INT)
int err = free(ptr);
if (err) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"System free returned error %d\n",err);
#else
free(ptr);
#endif
return 0;
}
PetscErrorCode PetscReallocAlign(size_t mem, int line, const char func[], const char file[], void **result)
{
if (!mem) {*result = NULL; return 0;}
#if (!(defined(PETSC_HAVE_DOUBLE_ALIGN_MALLOC) && (PETSC_MEMALIGN == 8)) && !defined(PETSC_HAVE_MEMALIGN))
{
/*
Previous int tells us how many ints the pointer has been shifted from
the original address provided by the system malloc().
*/
int shift = *(((int*)*result)-1) - SHIFT_CLASSID;
if (shift > PETSC_MEMALIGN-1) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"Likely memory corruption in heap");
if (shift < 0) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"Likely memory corruption in heap");
*result = (void*)(((int*)*result) - shift);
}
#endif
#if defined(PETSC_HAVE_DOUBLE_ALIGN_MALLOC) && (PETSC_MEMALIGN == 8)
*result = realloc(*result, mem);
#else
{
/*
malloc space for two extra chunks and shift ptr 1 + enough to get it PetscScalar aligned
*/
int *ptr = (int *) realloc(*result, mem + 2*PETSC_MEMALIGN);
if (ptr) {
int shift = (int)(((PETSC_UINTPTR_T) ptr) % PETSC_MEMALIGN);
shift = (2*PETSC_MEMALIGN - shift)/sizeof(int);
ptr[shift-1] = shift + SHIFT_CLASSID;
ptr += shift;
*result = (void*)ptr;
} else {
*result = NULL;
}
}
#endif
if (!*result) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_MEM,PETSC_ERROR_INITIAL,"Memory requested %.0f",(PetscLogDouble)mem);
return 0;
}
/*@C
PETSC_VIEWER_SOCKET_ - Creates a socket viewer shared by all processors in a communicator.
Collective on MPI_Comm
Input Parameter:
. comm - the MPI communicator to share the socket PetscViewer
Level: intermediate
Options Database Keys:
For use with the default PETSC_VIEWER_SOCKET_WORLD or if
PETSC_NULL is passed for machine or PETSC_DEFAULT is passed for port
$ -viewer_socket_machine <machine>
$ -viewer_socket_port <port>
Environmental variables:
+ PETSC_VIEWER_SOCKET_PORT portnumber
- PETSC_VIEWER_SOCKET_MACHINE machine name
Notes:
Unlike almost all other PETSc routines, PetscViewer_SOCKET_ does not return
an error code. The socket PetscViewer is usually used in the form
$ XXXView(XXX object,PETSC_VIEWER_SOCKET_(comm));
Currently the only socket client available is Matlab. See
src/dm/da/examples/tests/ex12.c and ex12.m for an example of usage.
Connects to a waiting socket and stays connected until PetscViewerDestroy() is called.
Use this for communicating with an interactive Matlab session, see PETSC_VIEWER_MATLAB_() for communicating with the Matlab engine.
.seealso: PETSC_VIEWER_SOCKET_WORLD, PETSC_VIEWER_SOCKET_SELF, PetscViewerSocketOpen(), PetscViewerCreate(),
PetscViewerSocketSetConnection(), PetscViewerDestroy(), PETSC_VIEWER_SOCKET_(), PetscViewerBinaryWrite(), PetscViewerBinaryRead(),
PetscViewerBinaryWriteStringArray(), PetscBinaryViewerGetDescriptor(), PETSC_VIEWER_MATLAB_()
@*/
PetscViewer PETSC_DLLEXPORT PETSC_VIEWER_SOCKET_(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscTruth flg;
PetscViewer viewer;
PetscFunctionBegin;
if (Petsc_Viewer_Socket_keyval == MPI_KEYVAL_INVALID) {
ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,MPI_NULL_DELETE_FN,&Petsc_Viewer_Socket_keyval,0);
if (ierr) {PetscError(__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,__SDIR__,1,1," ");PetscFunctionReturn(0);}
}
ierr = MPI_Attr_get(comm,Petsc_Viewer_Socket_keyval,(void **)&viewer,(int*)&flg);
if (ierr) {PetscError(__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,__SDIR__,1,1," ");PetscFunctionReturn(0);}
if (!flg) { /* PetscViewer not yet created */
ierr = PetscViewerSocketOpen(comm,0,0,&viewer);
if (ierr) {PetscError(__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,__SDIR__,1,1," ");PetscFunctionReturn(0);}
ierr = PetscObjectRegisterDestroy((PetscObject)viewer);
if (ierr) {PetscError(__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,__SDIR__,1,1," ");PetscFunctionReturn(0);}
ierr = MPI_Attr_put(comm,Petsc_Viewer_Socket_keyval,(void*)viewer);
if (ierr) {PetscError(__LINE__,"PETSC_VIEWER_SOCKET_",__FILE__,__SDIR__,1,1," ");PetscFunctionReturn(0);}
}
PetscFunctionReturn(viewer);
}
/*@C
PETSC_VIEWER_DRAW_ - Creates a window PetscViewer shared by all processors
in a communicator.
Collective on MPI_Comm
Input Parameter:
. comm - the MPI communicator to share the window PetscViewer
Level: intermediate
Notes:
Unlike almost all other PETSc routines, PETSC_VIEWER_DRAW_ does not return
an error code. The window is usually used in the form
$ XXXView(XXX object,PETSC_VIEWER_DRAW_(comm));
.seealso: PETSC_VIEWER_DRAW_WORLD, PETSC_VIEWER_DRAW_SELF, PetscViewerDrawOpen(),
@*/
PetscViewer PETSC_DLLEXPORT PETSC_VIEWER_DRAW_(MPI_Comm comm)
{
PetscErrorCode ierr;
PetscMPIInt flag;
PetscViewer viewer;
PetscFunctionBegin;
if (Petsc_Viewer_Draw_keyval == MPI_KEYVAL_INVALID) {
ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,MPI_NULL_DELETE_FN,&Petsc_Viewer_Draw_keyval,0);
if (ierr) {PetscError(__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,__SDIR__,1,1," ");PetscFunctionReturn(0);}
}
ierr = MPI_Attr_get(comm,Petsc_Viewer_Draw_keyval,(void **)&viewer,&flag);
if (ierr) {PetscError(__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,__SDIR__,1,1," ");PetscFunctionReturn(0);}
if (!flag) { /* PetscViewer not yet created */
ierr = PetscViewerDrawOpen(comm,0,0,PETSC_DECIDE,PETSC_DECIDE,300,300,&viewer);
if (ierr) {PetscError(__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,__SDIR__,1,1," ");PetscFunctionReturn(0);}
ierr = PetscObjectRegisterDestroy((PetscObject)viewer);
if (ierr) {PetscError(__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,__SDIR__,1,1," ");PetscFunctionReturn(0);}
ierr = MPI_Attr_put(comm,Petsc_Viewer_Draw_keyval,(void*)viewer);
if (ierr) {PetscError(__LINE__,"PETSC_VIEWER_DRAW_",__FILE__,__SDIR__,1,1," ");PetscFunctionReturn(0);}
}
PetscFunctionReturn(viewer);
}
/*@C
ADDAHCiterStartup - performs the first check for an iteration through a hypercube
lc, uc, idx all have to be valid arrays of size dim
This function sets idx to lc and then checks, whether the lower corner (lc) is less
than thre upper corner (uc). If lc "<=" uc in all coordinates, it returns PETSC_TRUE,
and PETSC_FALSE otherwise.
Input Parameters:
+ dim - the number of dimension
. lc - the "lower" corner
- uc - the "upper" corner
Output Parameters:
. idx - the index that this function increases
Developer Notes: This code is crap! You cannot return a value and NO ERROR code in PETSc!
Level: developer
@*/
PetscBool ADDAHCiterStartup(const PetscInt dim, const PetscInt *const lc, const PetscInt *const uc, PetscInt *const idx)
{
PetscErrorCode ierr;
PetscInt i;
ierr = PetscMemcpy(idx, lc, sizeof(PetscInt)*dim);
if (ierr) {
PetscError(PETSC_COMM_SELF,__LINE__,__FUNCT__,__FILE__,__SDIR__,ierr,PETSC_ERROR_REPEAT," ");
return PETSC_FALSE;
}
for (i=0; i<dim; i++) {
if (lc[i] > uc[i]) return PETSC_FALSE;
}
return PETSC_TRUE;
}
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "PetscDefaultFPTrap"
void PetscDefaultFPTrap(int sig)
{
const FPNode *node;
int code;
PetscBool matched = PETSC_FALSE;
PetscFunctionBegin;
/* Note: While it is possible for the exception state to be preserved by the
* kernel, this seems to be rare which makes the following flag testing almost
* useless. But on a system where the flags can be preserved, it would provide
* more detail.
*/
code = fetestexcept(FE_ALL_EXCEPT);
for (node=&error_codes[0]; node->code; node++) {
if (code & node->code) {
matched = PETSC_TRUE;
(*PetscErrorPrintf)("*** floating point error \"%s\" occurred ***\n",node->name);
code &= ~node->code; /* Unset this flag since it has been processed */
}
}
if (!matched || code) { /* If any remaining flags are set, or we didn't process any flags */
(*PetscErrorPrintf)("*** unknown floating point error occurred ***\n");
(*PetscErrorPrintf)("The specific exception can be determined by running in a debugger. When the\n");
(*PetscErrorPrintf)("debugger traps the signal, the exception can be found with fetestexcept(0x%x)\n",FE_ALL_EXCEPT);
(*PetscErrorPrintf)("where the result is a bitwise OR of the following flags:\n");
(*PetscErrorPrintf)("FE_INVALID=0x%x FE_DIVBYZERO=0x%x FE_OVERFLOW=0x%x FE_UNDERFLOW=0x%x FE_INEXACT=0x%x\n",FE_INVALID,FE_DIVBYZERO,FE_OVERFLOW,FE_UNDERFLOW,FE_INEXACT);
}
(*PetscErrorPrintf)("Try option -start_in_debugger\n");
#if defined(PETSC_USE_DEBUG)
if (!PetscStackActive) {
(*PetscErrorPrintf)(" or try option -log_stack\n");
} else {
(*PetscErrorPrintf)("likely location of problem given in stack below\n");
(*PetscErrorPrintf)("--------------------- Stack Frames ------------------------------------\n");
PetscStackView(PETSC_VIEWER_STDOUT_SELF);
}
#endif
#if !defined(PETSC_USE_DEBUG)
(*PetscErrorPrintf)("configure using --with-debugging=yes, recompile, link, and run \n");
(*PetscErrorPrintf)("with -start_in_debugger to get more information on the crash.\n");
#endif
PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,PETSC_ERROR_INITIAL,"trapped floating point error");
MPI_Abort(PETSC_COMM_WORLD,0);
}
PETSC_EXTERN void PETSC_STDCALL matrestorerow_(Mat *mat,PetscInt *row,PetscInt *ncols,PetscInt *cols,PetscScalar *vals,PetscErrorCode *ierr)
{
const PetscInt **oocols = &my_ocols;
const PetscScalar **oovals = &my_ovals;
if (!matgetrowactive) {
PetscError(PETSC_COMM_SELF,__LINE__,"MatRestoreRow_Fortran",__FILE__,PETSC_ERR_ARG_WRONGSTATE,PETSC_ERROR_INITIAL,
"Must call MatGetRow() first");
*ierr = 1;
return;
}
CHKFORTRANNULLINTEGER(cols); if (!cols) oocols = NULL;
CHKFORTRANNULLSCALAR(vals); if (!vals) oovals = NULL;
*ierr = MatRestoreRow(*mat,*row,ncols,oocols,oovals);
matgetrowactive = 0;
}
void PETSC_STDCALL matshellsetoperation_(Mat *mat,MatOperation *op,PetscErrorCode (PETSC_STDCALL *f)(Mat*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr)
{
MPI_Comm comm;
*ierr = PetscObjectGetComm((PetscObject)*mat,&comm);if (*ierr) return;
PetscObjectAllocateFortranPointers(*mat,11);
if (*op == MATOP_MULT) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourmult);
((PetscObject)*mat)->fortran_func_pointers[0] = (PetscVoidFunction)f;
} else if (*op == MATOP_MULT_TRANSPOSE) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourmulttranspose);
((PetscObject)*mat)->fortran_func_pointers[2] = (PetscVoidFunction)f;
} else if (*op == MATOP_MULT_ADD) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourmultadd);
((PetscObject)*mat)->fortran_func_pointers[1] = (PetscVoidFunction)f;
} else if (*op == MATOP_MULT_TRANSPOSE_ADD) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourmulttransposeadd);
((PetscObject)*mat)->fortran_func_pointers[3] = (PetscVoidFunction)f;
} else if (*op == MATOP_GET_DIAGONAL) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourgetdiagonal);
((PetscObject)*mat)->fortran_func_pointers[4] = (PetscVoidFunction)f;
} else if (*op == MATOP_DIAGONAL_SCALE) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourdiagonalscale);
((PetscObject)*mat)->fortran_func_pointers[5] = (PetscVoidFunction)f;
} else if (*op == MATOP_DIAGONAL_SET) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourdiagonalset);
((PetscObject)*mat)->fortran_func_pointers[6] = (PetscVoidFunction)f;
} else if (*op == MATOP_GET_VECS) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourgetvecs);
((PetscObject)*mat)->fortran_func_pointers[7] = (PetscVoidFunction)f;
} else if (*op == MATOP_VIEW) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourview);
((PetscObject)*mat)->fortran_func_pointers[8] = (PetscVoidFunction)f;
} else if (*op == MATOP_SOR) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)oursor);
((PetscObject)*mat)->fortran_func_pointers[9] = (PetscVoidFunction)f;
} else if (*op == MATOP_SHIFT) {
*ierr = MatShellSetOperation(*mat,*op,(PetscVoidFunction)ourshift);
((PetscObject)*mat)->fortran_func_pointers[10] = (PetscVoidFunction)f;
} else {
PetscError(comm,__LINE__,"MatShellSetOperation_Fortran",__FILE__,__SDIR__,PETSC_ERR_ARG_WRONG,PETSC_ERROR_INITIAL,
"Cannot set that matrix operation");
*ierr = 1;
}
}
void PetscDefaultFPTrap(unsigned exception[],int val[])
{
int err_ind,j,code;
PetscFunctionBegin;
code = exception[0];
err_ind = -1 ;
for (j = 0 ; error_codes[j].code_no ; j++){
if (error_codes[j].code_no == code) err_ind = j;
}
if (err_ind >= 0){
(*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
} else{
(*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",code);
}
PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
MPI_Abort(PETSC_COMM_WORLD,0);
}
void PetscDefaultFPTrap(int sig,siginfo_t *scp,ucontext_t *uap)
{
int err_ind,j,code = scp->si_code;
PetscErrorCode ierr;
PetscFunctionBegin;
err_ind = -1 ;
for (j = 0 ; error_codes[j].code_no ; j++) {
if (error_codes[j].code_no == code) err_ind = j;
}
if (err_ind >= 0) {
(*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
} else {
(*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
}
ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
MPI_Abort(PETSC_COMM_WORLD,0);
}
sigfpe_handler_type PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp,char *addr)
{
PetscErrorCode ierr;
int err_ind = -1,j;
PetscFunctionBegin;
for (j = 0 ; error_codes[j].code_no ; j++) {
if (error_codes[j].code_no == code) err_ind = j;
}
if (err_ind >= 0) {
(*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
} else {
(*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
}
ierr = PetscError(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
MPI_Abort(PETSC_COMM_WORLD,0);
PetscFunctionReturn(0);
}
EXTERN_C_BEGIN
/*
This is the same as the macro ISLocalToGlobalMappingApply() except it does not
return error codes.
*/
void PETSC_STDCALL islocaltoglobalmappingapply_(ISLocalToGlobalMapping *mapping,PetscInt *N,PetscInt *in,PetscInt *out,PetscErrorCode *ierr)
{
PetscInt i,*idx = (*mapping)->indices,Nmax = (*mapping)->n;
for (i=0; i<(*N); i++) {
if (in[i] < 0) {
out[i] = in[i];
continue;
}
if (in[i] >= Nmax) {
*ierr = PetscError(__LINE__,"ISLocalToGlobalMappingApply_Fortran",__FILE__,__SDIR__,1,1,"Index out of range");
return;
}
out[i] = idx[in[i]];
}
}
void PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp)
{
PetscErrorCode ierr;
int err_ind,j;
fp_ctx_t flt_context;
PetscFunctionBegin;
fp_sh_trap_info(scp,&flt_context);
err_ind = -1 ;
for (j = 0 ; error_codes[j].code_no ; j++) {
if (error_codes[j].code_no == flt_context.trap) err_ind = j;
}
if (err_ind >= 0){
(*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
} else{
(*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",flt_context.trap);
}
ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
MPI_Abort(PETSC_COMM_WORLD,0);
}
PETSC_INTERN void PetscScAbort_longjmp(void)
{
PetscError(PETSC_COMM_SELF,-1,"p4est function","p4est file",PETSC_ERR_LIB,PETSC_ERROR_INITIAL,"Error in p4est stack call\n");
longjmp(PetscScJumpBuf,1);
return;
}
/*@C
PetscDLOpen - opens dynamic library
Not Collective
Input Parameters:
+ name - name of library
- mode - options on how to open library
Output Parameter:
. handle
Level: developer
@*/
PetscErrorCode PetscDLOpen(const char name[],PetscDLMode mode,PetscDLHandle *handle)
{
PETSC_UNUSED int dlflags1,dlflags2; /* There are some preprocessor paths where these variables are set, but not used */
dlhandle_t dlhandle;
PetscFunctionBegin;
PetscValidCharPointer(name,1);
PetscValidPointer(handle,3);
dlflags1 = 0;
dlflags2 = 0;
dlhandle = (dlhandle_t) 0;
*handle = (PetscDLHandle) 0;
/*
--- LoadLibrary ---
*/
#if defined(PETSC_HAVE_WINDOWS_H) && defined(PETSC_HAVE_LOADLIBRARY)
dlhandle = LoadLibrary(name);
if (!dlhandle) {
#if defined(PETSC_HAVE_GETLASTERROR)
PetscErrorCode ierr;
DWORD erc;
char *buff = NULL;
erc = GetLastError();
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_IGNORE_INSERTS,
NULL,erc,MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),(LPSTR)&buff,0,NULL);
ierr = PetscError(PETSC_COMM_SELF,__LINE__,PETSC_FUNCTION_NAME,__FILE__,PETSC_ERR_FILE_OPEN,PETSC_ERROR_REPEAT,
"Unable to open dynamic library:\n %s\n Error message from LoadLibrary() %s\n",name,buff);
LocalFree(buff);
PetscFunctionReturn(ierr);
#else
SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to open dynamic library:\n %s\n Error message from LoadLibrary() %s\n",name,"unavailable");
#endif
}
/*
--- dlopen ---
*/
#elif defined(PETSC_HAVE_DLFCN_H) && defined(PETSC_HAVE_DLOPEN)
/*
Mode indicates symbols required by symbol loaded with dlsym()
are only loaded when required (not all together) also indicates
symbols required can be contained in other libraries also opened
with dlopen()
*/
#if defined(PETSC_HAVE_RTLD_LAZY)
dlflags1 = RTLD_LAZY;
#endif
#if defined(PETSC_HAVE_RTLD_NOW)
if (mode & PETSC_DL_NOW) dlflags1 = RTLD_NOW;
#endif
#if defined(PETSC_HAVE_RTLD_GLOBAL)
dlflags2 = RTLD_GLOBAL;
#endif
#if defined(PETSC_HAVE_RTLD_LOCAL)
if (mode & PETSC_DL_LOCAL) dlflags2 = RTLD_LOCAL;
#endif
#if defined(PETSC_HAVE_DLERROR)
dlerror(); /* clear any previous error */
#endif
dlhandle = dlopen(name,dlflags1|dlflags2);
if (!dlhandle) {
#if defined(PETSC_HAVE_DLERROR)
const char *errmsg = dlerror();
#else
const char *errmsg = "unavailable";
#endif
SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to open dynamic library:\n %s\n Error message from dlopen() %s\n",name,errmsg);
}
/*
--- unimplemented ---
*/
#else
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS, "Cannot use dynamic libraries on this platform");
#endif
*handle = (PetscDLHandle) dlhandle;
PetscFunctionReturn(0);
}
