int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscMPIInt rank;
char buffer[256],*output,user[256];
PetscBool userhappy = PETSC_FALSE;
PetscInitialize(&argc,&argv,(char*)0,help);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
ierr = PetscMatlabEngineGetOutput(PETSC_MATLAB_ENGINE_(PETSC_COMM_WORLD),&output);CHKERRQ(ierr);
ierr = PetscMatlabEngineEvaluate(PETSC_MATLAB_ENGINE_(PETSC_COMM_WORLD),"MPI_Comm_rank");CHKERRQ(ierr);
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d]Processor rank is %s",rank,output);CHKERRQ(ierr);
ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,PETSC_STDOUT);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,">>");CHKERRQ(ierr);
ierr = PetscSynchronizedFGets(PETSC_COMM_WORLD,stdin,256,user);CHKERRQ(ierr);
ierr = PetscStrncmp(user,"exit",4,&userhappy);CHKERRQ(ierr);
while (!userhappy) {
ierr = PetscMatlabEngineEvaluate(PETSC_MATLAB_ENGINE_(PETSC_COMM_WORLD),user);CHKERRQ(ierr);
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d]The result is %s",rank,output);CHKERRQ(ierr);
ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,PETSC_STDOUT);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,">>");CHKERRQ(ierr);
ierr = PetscSynchronizedFGets(PETSC_COMM_WORLD,stdin,256,user);CHKERRQ(ierr);
ierr = PetscStrncmp(user,"exit",4,&userhappy);CHKERRQ(ierr);
}
ierr = PetscFinalize();
return 0;
}
/*@C
PetscTraceBackErrorHandler - Default error handler routine that generates
a traceback on error detection.
Not Collective
Input Parameters:
+ comm - communicator over which error occurred
. line - the line number of the error (indicated by __LINE__)
. func - the function where error is detected (indicated by __FUNCT__)
. file - the file in which the error was detected (indicated by __FILE__)
. mess - an error text string, usually just printed to the screen
. n - the generic error number
. p - PETSC_ERROR_INITIAL if this is the first call the error handler, otherwise PETSC_ERROR_REPEAT
- ctx - error handler context
Level: developer
Notes:
Most users need not directly employ this routine and the other error
handlers, but can instead use the simplified interface SETERRQ, which has
the calling sequence
$ SETERRQ(comm,number,n,mess)
Notes for experienced users:
Use PetscPushErrorHandler() to set the desired error handler. The
currently available PETSc error handlers include PetscTraceBackErrorHandler(),
PetscAttachDebuggerErrorHandler(), PetscAbortErrorHandler(), and PetscMPIAbortErrorHandler()
Concepts: error handler^traceback
Concepts: traceback^generating
.seealso: PetscPushErrorHandler(), PetscAttachDebuggerErrorHandler(),
PetscAbortErrorHandler()
@*/
PetscErrorCode PetscTraceBackErrorHandler(MPI_Comm comm,int line,const char *fun,const char *file,PetscErrorCode n,PetscErrorType p,const char *mess,void *ctx)
{
PetscLogDouble mem,rss;
PetscBool flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE;
PetscMPIInt rank = 0;
PetscFunctionBegin;
if (comm != PETSC_COMM_SELF) MPI_Comm_rank(comm,&rank);
if (!rank) {
PetscBool ismain,isunknown;
static int cnt = 1;
if (p == PETSC_ERROR_INITIAL) {
PetscErrorPrintfHilight();
(*PetscErrorPrintf)("--------------------- Error Message --------------------------------------------------------------\n");
PetscErrorPrintfNormal();
if (n == PETSC_ERR_MEM) {
(*PetscErrorPrintf)("Out of memory. This could be due to allocating\n");
(*PetscErrorPrintf)("too large an object or bleeding by not properly\n");
(*PetscErrorPrintf)("destroying unneeded objects.\n");
PetscMallocGetCurrentUsage(&mem);
PetscMemoryGetCurrentUsage(&rss);
PetscOptionsGetBool(NULL,"-malloc_dump",&flg1,NULL);
PetscOptionsGetBool(NULL,"-malloc_log",&flg2,NULL);
PetscOptionsHasName(NULL,"-malloc_log_threshold",&flg3);
if (flg2 || flg3) PetscMallocDumpLog(stdout);
else {
(*PetscErrorPrintf)("Memory allocated %.0f Memory used by process %.0f\n",mem,rss);
if (flg1) PetscMallocDump(stdout);
else (*PetscErrorPrintf)("Try running with -malloc_dump or -malloc_log for info.\n");
}
} else {
const char *text;
PetscErrorMessage(n,&text,NULL);
if (text) (*PetscErrorPrintf)("%s\n",text);
}
if (mess) (*PetscErrorPrintf)("%s\n",mess);
(*PetscErrorPrintf)("See http://www.mcs.anl.gov/petsc/documentation/faq.html for trouble shooting.\n");
(*PetscErrorPrintf)("%s\n",version);
if (PetscErrorPrintfInitializeCalled) (*PetscErrorPrintf)("%s on a %s named %s by %s %s\n",pname,arch,hostname,username,date);
(*PetscErrorPrintf)("Configure options %s\n",petscconfigureoptions);
}
/* print line of stack trace */
(*PetscErrorPrintf)("#%d %s() line %d in %s\n",cnt++,fun,line,file);
PetscStrncmp(fun,"main",4,&ismain);
PetscStrncmp(fun,"unknown",7,&isunknown);
if (ismain || isunknown) {
PetscOptionsViewError();
PetscErrorPrintfHilight();
(*PetscErrorPrintf)("----------------End of Error Message -------send entire error message to [email protected]\n");
PetscErrorPrintfNormal();
}
} else {
/* do not print error messages since process 0 will print them, sleep before aborting so will not accidently kill process 0*/
PetscSleep(10.0);
abort();
}
PetscFunctionReturn(n);
}
/*@C
DMPlexCreateGmshFromFile - Create a DMPlex mesh from a Gmsh file
+ comm - The MPI communicator
. filename - Name of the Gmsh file
- interpolate - Create faces and edges in the mesh
Output Parameter:
. dm - The DM object representing the mesh
Level: beginner
.seealso: DMPlexCreateFromFile(), DMPlexCreateGmsh(), DMPlexCreate()
@*/
PetscErrorCode DMPlexCreateGmshFromFile(MPI_Comm comm, const char filename[], PetscBool interpolate, DM *dm)
{
PetscViewer viewer, vheader;
PetscMPIInt rank;
PetscViewerType vtype;
char line[PETSC_MAX_PATH_LEN];
int snum;
PetscBool match;
int fT;
PetscInt fileType;
float version;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MPI_Comm_rank(comm, &rank);
CHKERRQ(ierr);
/* Determine Gmsh file type (ASCII or binary) from file header */
ierr = PetscViewerCreate(comm, &vheader);
CHKERRQ(ierr);
ierr = PetscViewerSetType(vheader, PETSCVIEWERASCII);
CHKERRQ(ierr);
ierr = PetscViewerFileSetMode(vheader, FILE_MODE_READ);
CHKERRQ(ierr);
ierr = PetscViewerFileSetName(vheader, filename);
CHKERRQ(ierr);
if (!rank) {
/* Read only the first two lines of the Gmsh file */
ierr = PetscViewerRead(vheader, line, 1, NULL, PETSC_STRING);
CHKERRQ(ierr);
ierr = PetscStrncmp(line, "$MeshFormat", PETSC_MAX_PATH_LEN, &match);
CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
ierr = PetscViewerRead(vheader, line, 2, NULL, PETSC_STRING);
CHKERRQ(ierr);
snum = sscanf(line, "%f %d", &version, &fT);
fileType = (PetscInt) fT;
if (snum != 2) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unable to parse Gmsh file header: %s", line);
if (version < 2.0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Gmsh file must be at least version 2.0");
}
ierr = MPI_Bcast(&fileType, 1, MPIU_INT, 0, comm);
CHKERRQ(ierr);
/* Create appropriate viewer and build plex */
if (fileType == 0) vtype = PETSCVIEWERASCII;
else vtype = PETSCVIEWERBINARY;
ierr = PetscViewerCreate(comm, &viewer);
CHKERRQ(ierr);
ierr = PetscViewerSetType(viewer, vtype);
CHKERRQ(ierr);
ierr = PetscViewerFileSetMode(viewer, FILE_MODE_READ);
CHKERRQ(ierr);
ierr = PetscViewerFileSetName(viewer, filename);
CHKERRQ(ierr);
ierr = DMPlexCreateGmsh(comm, viewer, interpolate, dm);
CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);
CHKERRQ(ierr);
ierr = PetscViewerDestroy(&vheader);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
PetscError - Routine that is called when an error has been detected,
usually called through the macro SETERRQ(PETSC_COMM_SELF,).
Not Collective
Input Parameters:
+ comm - communicator over which error occurred. ALL ranks of this communicator MUST call this routine
. line - the line number of the error (indicated by __LINE__)
. func - the function where the error occured (indicated by __FUNCT__)
. dir - the directory of file (indicated by __SDIR__)
. file - the file in which the error was detected (indicated by __FILE__)
. mess - an error text string, usually just printed to the screen
. n - the generic error number
. p - PETSC_ERROR_INITIAL indicates the error was initially detected, PETSC_ERROR_REPEAT indicates this is a traceback from a previously detected error
- mess - formatted message string - aka printf
Level: intermediate
Notes:
Most users need not directly use this routine and the error handlers, but
can instead use the simplified interface SETERRQ, which has the calling
sequence
$ SETERRQ(comm,n,mess)
Experienced users can set the error handler with PetscPushErrorHandler().
Developer Note: Since this is called after an error condition it should not be calling any error handlers (currently it ignores any error codes)
BUT this routine does call regular PETSc functions that may call error handlers, this is problematic and could be fixed by never calling other PETSc routines
but this annoying.
Concepts: error^setting condition
.seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), SETERRQ(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
@*/
PetscErrorCode PetscError(MPI_Comm comm,int line,const char *func,const char *file,const char *dir,PetscErrorCode n,PetscErrorType p,const char *mess,...)
{
va_list Argp;
size_t fullLength;
char buf[2048],*lbuf = 0;
PetscBool ismain,isunknown;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!func) func = "User provided function";
if (!file) file = "User file";
if (!dir) dir = " ";
if (comm == MPI_COMM_NULL) comm = PETSC_COMM_SELF;
/* Compose the message evaluating the print format */
if (mess) {
va_start(Argp,mess);
PetscVSNPrintf(buf,2048,mess,&fullLength,Argp);
va_end(Argp);
lbuf = buf;
if (p == 1) PetscStrncpy(PetscErrorBaseMessage,lbuf,1023);
}
if (!eh) ierr = PetscTraceBackErrorHandler(comm,line,func,file,dir,n,p,lbuf,0);
else ierr = (*eh->handler)(comm,line,func,file,dir,n,p,lbuf,eh->ctx);
/*
If this is called from the main() routine we call MPI_Abort() instead of
return to allow the parallel program to be properly shutdown.
Since this is in the error handler we don't check the errors below. Of course,
PetscStrncmp() does its own error checking which is problamatic
*/
PetscStrncmp(func,"main",4,&ismain);
PetscStrncmp(func,"unknown",7,&isunknown);
if (ismain || isunknown) MPI_Abort(PETSC_COMM_WORLD,(int)ierr);
#if defined(PETSC_CLANGUAGE_CXX)
if (p == PETSC_ERROR_IN_CXX) {
PetscCxxErrorThrow();
}
#endif
PetscFunctionReturn(ierr);
}
int TaoPetscApplication::GetLinearSolver(TaoMat *tH, int stype, TaoLinearSolver **SS)
{
TaoMatPetsc *pH = dynamic_cast <TaoMatPetsc *> (tH);
Mat pm, pmpre;
MatStructure pflag;
MPI_Comm comm2;
int info;
const MatType mtype;
PC pc;
KSP newksp;
TaoLinearSolverPetsc *S;
PetscTruth flg1,flg2;
PetscFunctionBegin;
info = pH->GetMatrix(&pm,&pmpre,&pflag); CHKERRQ(info);
info = TaoAppGetKSP(papp,&newksp); CHKERRQ(info);
if (this->ksptmp==0){
info = TaoWrapKSP( newksp, &S ); CHKERRQ(info);
this->ksptmp=S;
}
info=this->ksptmp->SetKSP(newksp);CHKERRQ(info);
*SS=this->ksptmp;
if (pm) {
info = PetscObjectGetComm((PetscObject)pm,&comm2); CHKERRQ(info);
info = MatGetType(pm,&mtype); CHKERRQ(info);
info = PetscStrncmp(mtype,MATSEQDENSE,10,&flg1); CHKERRQ(info);
info = PetscStrncmp(mtype,MATMPIDENSE,10,&flg2); CHKERRQ(info);
}
else {
comm2 = this->comm;
}
info = KSPGetPC(newksp,&pc); CHKERRQ(info);
info=KSPSetFromOptions(newksp); CHKERRQ(info);
PetscFunctionReturn(0);
}
/*@
DMPlexCreateGmsh - Create a DMPlex mesh from a Gmsh file.
Collective on comm
Input Parameters:
+ comm - The MPI communicator
. viewer - The Viewer associated with a Gmsh file
- interpolate - Create faces and edges in the mesh
Output Parameter:
. dm - The DM object representing the mesh
Note: http://www.geuz.org/gmsh/doc/texinfo/#MSH-ASCII-file-format
Level: beginner
.keywords: mesh,Gmsh
.seealso: DMPLEX, DMCreate()
@*/
PetscErrorCode DMPlexCreateGmsh(MPI_Comm comm, PetscViewer viewer, PetscBool interpolate, DM *dm)
{
FILE *fd;
PetscSection coordSection;
Vec coordinates;
PetscScalar *coords, *coordsIn = NULL;
PetscInt dim = 0, coordSize, c, v, d;
int numVertices = 0, numCells = 0, snum;
long fpos = 0;
PetscMPIInt num_proc, rank;
char line[PETSC_MAX_PATH_LEN];
PetscBool match;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &num_proc);CHKERRQ(ierr);
ierr = DMCreate(comm, dm);CHKERRQ(ierr);
ierr = DMSetType(*dm, DMPLEX);CHKERRQ(ierr);
if (!rank) {
PetscBool match;
int fileType, dataSize;
ierr = PetscViewerASCIIGetPointer(viewer, &fd);CHKERRQ(ierr);
/* Read header */
fgets(line, PETSC_MAX_PATH_LEN, fd);
ierr = PetscStrncmp(line, "$MeshFormat\n", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
snum = fscanf(fd, "2.2 %d %d\n", &fileType, &dataSize);CHKERRQ(snum != 2);
if (fileType) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File type %d is not a valid Gmsh ASCII file", fileType);
if (dataSize != sizeof(double)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Data size %d is not valid for a Gmsh file", dataSize);
fgets(line, PETSC_MAX_PATH_LEN, fd);
ierr = PetscStrncmp(line, "$EndMeshFormat\n", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
/* Read vertices */
fgets(line, PETSC_MAX_PATH_LEN, fd);
ierr = PetscStrncmp(line, "$Nodes\n", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
snum = fscanf(fd, "%d\n", &numVertices);CHKERRQ(snum != 1);
ierr = PetscMalloc(numVertices*3 * sizeof(PetscScalar), &coordsIn);CHKERRQ(ierr);
for (v = 0; v < numVertices; ++v) {
double x, y, z;
int i;
snum = fscanf(fd, "%d %lg %lg %lg\n", &i, &x, &y, &z);CHKERRQ(snum != 4);
coordsIn[v*3+0] = x; coordsIn[v*3+1] = y; coordsIn[v*3+2] = z;
if (i != v+1) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Invalid node number %d should be %d", i, v+1);
}
fgets(line, PETSC_MAX_PATH_LEN, fd);
ierr = PetscStrncmp(line, "$EndNodes\n", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
/* Read cells */
fgets(line, PETSC_MAX_PATH_LEN, fd);
ierr = PetscStrncmp(line, "$Elements\n", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
snum = fscanf(fd, "%d\n", &numCells);CHKERRQ(snum != 1);
}
ierr = DMPlexSetChart(*dm, 0, numCells+numVertices);CHKERRQ(ierr);
if (!rank) {
fpos = ftell(fd);
for (c = 0; c < numCells; ++c) {
PetscInt numCorners, t;
int cone[8], i, cellType, numTags, tag;
snum = fscanf(fd, "%d %d %d", &i, &cellType, &numTags);CHKERRQ(snum != 3);
if (numTags) for (t = 0; t < numTags; ++t) {snum = fscanf(fd, "%d", &tag);CHKERRQ(snum != 1);}
switch (cellType) {
case 1: /* 2-node line */
dim = 1;
numCorners = 2;
snum = fscanf(fd, "%d %d\n", &cone[0], &cone[1]);CHKERRQ(snum != numCorners);
break;
case 2: /* 3-node triangle */
dim = 2;
numCorners = 3;
snum = fscanf(fd, "%d %d %d\n", &cone[0], &cone[1], &cone[2]);CHKERRQ(snum != numCorners);
break;
case 3: /* 4-node quadrangle */
dim = 2;
numCorners = 4;
snum = fscanf(fd, "%d %d %d %d\n", &cone[0], &cone[1], &cone[2], &cone[3]);CHKERRQ(snum != numCorners);
break;
case 4: /* 4-node tetrahedron */
dim = 3;
numCorners = 4;
snum = fscanf(fd, "%d %d %d %d\n", &cone[0], &cone[1], &cone[2], &cone[3]);CHKERRQ(snum != numCorners);
break;
case 5: /* 8-node hexahedron */
dim = 3;
numCorners = 8;
snum = fscanf(fd, "%d %d %d %d %d %d %d %d\n", &cone[0], &cone[1], &cone[2], &cone[3], &cone[4], &cone[5], &cone[6], &cone[7]);CHKERRQ(snum != numCorners);
break;
default:
SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported Gmsh element type %d", cellType);
}
ierr = DMPlexSetConeSize(*dm, c, numCorners);CHKERRQ(ierr);
if (i != c+1) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Invalid cell number %d should be %d", i, c+1);
}
}
ierr = DMSetUp(*dm);CHKERRQ(ierr);
if (!rank) {
ierr = fseek(fd, fpos, SEEK_SET);CHKERRQ(ierr);
for (c = 0; c < numCells; ++c) {
PetscInt pcone[8], numCorners, corner, t;
int cone[8], i, cellType, numTags, tag;
snum = fscanf(fd, "%d %d %d", &i, &cellType, &numTags);CHKERRQ(snum != 3);
if (numTags) for (t = 0; t < numTags; ++t) {snum = fscanf(fd, "%d", &tag);CHKERRQ(snum != 1);}
switch (cellType) {
case 1: /* 2-node line */
dim = 1;
numCorners = 2;
snum = fscanf(fd, "%d %d\n", &cone[0], &cone[1]);CHKERRQ(snum != numCorners);
break;
case 2: /* 3-node triangle */
dim = 2;
numCorners = 3;
snum = fscanf(fd, "%d %d %d\n", &cone[0], &cone[1], &cone[2]);CHKERRQ(snum != numCorners);
break;
case 3: /* 4-node quadrangle */
dim = 2;
numCorners = 4;
snum = fscanf(fd, "%d %d %d %d\n", &cone[0], &cone[1], &cone[2], &cone[3]);CHKERRQ(snum != numCorners);
break;
case 4: /* 4-node tetrahedron */
dim = 3;
numCorners = 4;
snum = fscanf(fd, "%d %d %d %d\n", &cone[0], &cone[1], &cone[2], &cone[3]);CHKERRQ(snum != numCorners);
ierr = DMPlexInvertCell(dim, numCorners, cone);CHKERRQ(ierr);
break;
case 5: /* 8-node hexahedron */
dim = 3;
numCorners = 8;
snum = fscanf(fd, "%d %d %d %d %d %d %d %d\n", &cone[0], &cone[1], &cone[2], &cone[3], &cone[4], &cone[5], &cone[6], &cone[7]);CHKERRQ(snum != numCorners);
ierr = DMPlexInvertCell(dim, numCorners, cone);CHKERRQ(ierr);
break;
default:
SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported Gmsh element type %d", cellType);
}
for (corner = 0; corner < numCorners; ++corner) pcone[corner] = cone[corner] + numCells-1;
ierr = DMPlexSetCone(*dm, c, pcone);CHKERRQ(ierr);
if (i != c+1) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Invalid cell number %d should be %d", i, c+1);
}
fgets(line, PETSC_MAX_PATH_LEN, fd);
ierr = PetscStrncmp(line, "$EndElements\n", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
}
ierr = MPI_Bcast(&dim, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
ierr = DMPlexSetDimension(*dm, dim);CHKERRQ(ierr);
ierr = DMPlexSymmetrize(*dm);CHKERRQ(ierr);
ierr = DMPlexStratify(*dm);CHKERRQ(ierr);
if (interpolate) {
DM idm;
ierr = DMPlexInterpolate(*dm, &idm);CHKERRQ(ierr);
ierr = DMDestroy(dm);CHKERRQ(ierr);
*dm = idm;
}
/* Read coordinates */
ierr = DMGetCoordinateSection(*dm, &coordSection);CHKERRQ(ierr);
ierr = PetscSectionSetNumFields(coordSection, 1);CHKERRQ(ierr);
ierr = PetscSectionSetFieldComponents(coordSection, 0, dim);CHKERRQ(ierr);
ierr = PetscSectionSetChart(coordSection, numCells, numCells + numVertices);CHKERRQ(ierr);
for (v = numCells; v < numCells+numVertices; ++v) {
ierr = PetscSectionSetDof(coordSection, v, dim);CHKERRQ(ierr);
ierr = PetscSectionSetFieldDof(coordSection, v, 0, dim);CHKERRQ(ierr);
}
ierr = PetscSectionSetUp(coordSection);CHKERRQ(ierr);
ierr = PetscSectionGetStorageSize(coordSection, &coordSize);CHKERRQ(ierr);
ierr = VecCreate(comm, &coordinates);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) coordinates, "coordinates");CHKERRQ(ierr);
ierr = VecSetSizes(coordinates, coordSize, PETSC_DETERMINE);CHKERRQ(ierr);
ierr = VecSetType(coordinates, VECSTANDARD);CHKERRQ(ierr);
ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
if (!rank) {
for (v = 0; v < numVertices; ++v) {
for (d = 0; d < dim; ++d) {
coords[v*dim+d] = coordsIn[v*3+d];
}
}
}
ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
ierr = PetscFree(coordsIn);CHKERRQ(ierr);
ierr = DMSetCoordinatesLocal(*dm, coordinates);CHKERRQ(ierr);
ierr = VecDestroy(&coordinates);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
PetscGetFullPath - Given a filename, returns the fully qualified file name.
Not Collective
Input Parameters:
+ path - pathname to qualify
. fullpath - pointer to buffer to hold full pathname
- flen - size of fullpath
Level: developer
Concepts: full path
Concepts: path^full
.seealso: PetscGetRelativePath()
@*/
PetscErrorCode PetscGetFullPath(const char path[],char fullpath[],size_t flen)
{
PetscErrorCode ierr;
size_t ln;
PetscBool flg;
PetscFunctionBegin;
if (path[0] == '/') {
ierr = PetscStrncmp("/tmp_mnt/",path,9,&flg);CHKERRQ(ierr);
if (flg) {ierr = PetscStrncpy(fullpath,path + 8,flen);CHKERRQ(ierr);}
else {ierr = PetscStrncpy(fullpath,path,flen);CHKERRQ(ierr);}
fullpath[flen-1] = 0;
PetscFunctionReturn(0);
}
ierr = PetscStrncpy(fullpath,path,flen);CHKERRQ(ierr);
fullpath[flen-1] = 0;
/* Remove the various "special" forms (~username/ and ~/) */
if (fullpath[0] == '~') {
char tmppath[PETSC_MAX_PATH_LEN],*rest;
if (fullpath[1] == '/') {
ierr = PetscGetHomeDirectory(tmppath,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
rest = fullpath + 2;
} else {
#if defined(PETSC_HAVE_PWD_H)
struct passwd *pwde;
char *p,*name;
/* Find username */
name = fullpath + 1;
p = name;
while (*p && *p != '/') p++;
*p = 0;
rest = p + 1;
pwde = getpwnam(name);
if (!pwde) PetscFunctionReturn(0);
ierr = PetscStrcpy(tmppath,pwde->pw_dir);CHKERRQ(ierr);
#else
PetscFunctionReturn(0);
#endif
}
ierr = PetscStrlen(tmppath,&ln);CHKERRQ(ierr);
if (tmppath[ln-1] != '/') {ierr = PetscStrcat(tmppath+ln-1,"/");CHKERRQ(ierr);}
ierr = PetscStrcat(tmppath,rest);CHKERRQ(ierr);
ierr = PetscStrncpy(fullpath,tmppath,flen);CHKERRQ(ierr);
fullpath[flen-1] = 0;
} else {
ierr = PetscGetWorkingDirectory(fullpath,flen);CHKERRQ(ierr);
ierr = PetscStrlen(fullpath,&ln);CHKERRQ(ierr);
ierr = PetscStrncpy(fullpath+ln,"/",flen - ln);CHKERRQ(ierr);
fullpath[flen-1] = 0;
ierr = PetscStrlen(fullpath,&ln);CHKERRQ(ierr);
if (path[0] == '.' && path[1] == '/') {
ierr = PetscStrncat(fullpath,path+2,flen - ln - 1);CHKERRQ(ierr);
} else {
ierr = PetscStrncat(fullpath,path,flen - ln - 1);CHKERRQ(ierr);
}
fullpath[flen-1] = 0;
}
/* Remove the automounter part of the path */
ierr = PetscStrncmp(fullpath,"/tmp_mnt/",9,&flg);CHKERRQ(ierr);
if (flg) {
char tmppath[PETSC_MAX_PATH_LEN];
ierr = PetscStrcpy(tmppath,fullpath + 8);CHKERRQ(ierr);
ierr = PetscStrcpy(fullpath,tmppath);CHKERRQ(ierr);
}
/* We could try to handle things like the removal of .. etc */
PetscFunctionReturn(0);
}
/*@
PetscAttachDebugger - Attaches the debugger to the running process.
Not Collective
Level: advanced
Concepts: debugger^starting from program
Developer Notes: Since this can be called by the error handler should it be calling SETERRQ() and CHKERRQ()?
.seealso: PetscSetDebugger()
@*/
PetscErrorCode PetscAttachDebugger(void)
{
#if !defined(PETSC_CANNOT_START_DEBUGGER)
int child =0;
PetscReal sleeptime=0;
PetscErrorCode ierr;
char program[PETSC_MAX_PATH_LEN],display[256],hostname[64];
#endif
PetscFunctionBegin;
#if defined(PETSC_CANNOT_START_DEBUGGER) || !defined(PETSC_HAVE_FORK)
(*PetscErrorPrintf)("System cannot start debugger\n");
(*PetscErrorPrintf)("On Cray run program in Totalview debugger\n");
(*PetscErrorPrintf)("On Windows use Developer Studio(MSDEV)\n");
MPI_Abort(PETSC_COMM_WORLD,1);
#else
ierr = PetscGetDisplay(display,128);CHKERRQ(ierr);
ierr = PetscGetProgramName(program,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
if (ierr) {
(*PetscErrorPrintf)("Cannot determine program name\n");
PetscFunctionReturn(1);
}
if (!program[0]) {
(*PetscErrorPrintf)("Cannot determine program name\n");
PetscFunctionReturn(1);
}
child = (int)fork();
if (child < 0) {
(*PetscErrorPrintf)("Error in fork() attaching debugger\n");
PetscFunctionReturn(1);
}
/*
Swap role the parent and child. This is (I think) so that control c typed
in the debugger goes to the correct process.
*/
if (child) child = 0;
else child = (int)getppid();
if (child) { /* I am the parent, will run the debugger */
const char *args[10];
char pid[10];
PetscInt j,jj;
PetscBool isdbx,isidb,isxldb,isxxgdb,isups,isxdb,isworkshop,isddd,iskdbg,islldb;
ierr = PetscGetHostName(hostname,64);CHKERRQ(ierr);
/*
We need to send a continue signal to the "child" process on the
alpha, otherwise it just stays off forever
*/
#if defined(PETSC_NEED_KILL_FOR_DEBUGGER)
kill(child,SIGCONT);
#endif
sprintf(pid,"%d",child);
ierr = PetscStrcmp(Debugger,"xxgdb",&isxxgdb);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"ddd",&isddd);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"kdbg",&iskdbg);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"ups",&isups);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"xldb",&isxldb);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"xdb",&isxdb);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"dbx",&isdbx);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"idb",&isidb);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"workshop",&isworkshop);CHKERRQ(ierr);
ierr = PetscStrcmp(Debugger,"lldb",&islldb);CHKERRQ(ierr);
if (isxxgdb || isups || isddd) {
args[1] = program; args[2] = pid; args[3] = "-display";
args[0] = Debugger; args[4] = display; args[5] = 0;
(*PetscErrorPrintf)("PETSC: Attaching %s to %s %s on %s\n",args[0],args[1],pid,hostname);
if (execvp(args[0],(char**)args) < 0) {
perror("Unable to start debugger");
exit(0);
}
} else if (iskdbg) {
args[1] = "-p"; args[2] = pid; args[3] = program; args[4] = "-display";
args[0] = Debugger; args[5] = display; args[6] = 0;
(*PetscErrorPrintf)("PETSC: Attaching %s to %s %s on %s\n",args[0],args[3],pid,hostname);
if (execvp(args[0],(char**)args) < 0) {
perror("Unable to start debugger");
exit(0);
}
} else if (isxldb) {
args[1] = "-a"; args[2] = pid; args[3] = program; args[4] = "-display";
args[0] = Debugger; args[5] = display; args[6] = 0;
(*PetscErrorPrintf)("PETSC: Attaching %s to %s %s on %s\n",args[0],args[1],pid,hostname);
if (execvp(args[0],(char**)args) < 0) {
perror("Unable to start debugger");
exit(0);
}
} else if (isworkshop) {
args[1] = "-s"; args[2] = pid; args[3] = "-D"; args[4] = "-";
args[0] = Debugger; args[5] = pid; args[6] = "-display"; args[7] = display; args[8] = 0;
(*PetscErrorPrintf)("PETSC: Attaching %s to %s on %s\n",args[0],pid,hostname);
if (execvp(args[0],(char**)args) < 0) {
perror("Unable to start debugger");
exit(0);
}
} else {
j = 0;
if (Xterm) {
PetscBool cmp;
char *tmp,*tmp1;
ierr = PetscStrncmp(DebugTerminal,"screen",6,&cmp);CHKERRQ(ierr);
if (cmp) display[0] = 0; /* when using screen, we never pass -display */
args[j++] = tmp = DebugTerminal;
if (display[0]) {
args[j++] = "-display"; args[j++] = display;
}
while (*tmp) {
ierr = PetscStrchr(tmp,' ',&tmp1);CHKERRQ(ierr);
if (!tmp1) break;
*tmp1 = 0;
tmp = tmp1+1;
args[j++] = tmp;
}
}
args[j++] = Debugger;
jj = j;
args[j++] = program; args[j++] = pid; args[j++] = 0;
if (isidb) {
j = jj;
args[j++] = "-pid";
args[j++] = pid;
args[j++] = "-gdb";
args[j++] = program;
args[j++] = 0;
}
if (islldb) {
j = jj;
args[j++] = "-p";
args[j++] = pid;
args[j++] = 0;
}
if (isdbx) {
j = jj;
#if defined(PETSC_USE_P_FOR_DEBUGGER)
args[j++] = "-p";
args[j++] = pid;
args[j++] = program;
#elif defined(PETSC_USE_LARGEP_FOR_DEBUGGER)
args[j++] = "-l";
args[j++] = "ALL";
args[j++] = "-P";
args[j++] = pid;
args[j++] = program;
#elif defined(PETSC_USE_A_FOR_DEBUGGER)
args[j++] = "-a";
args[j++] = pid;
#elif defined(PETSC_USE_PID_FOR_DEBUGGER)
args[j++] = "-pid";
args[j++] = pid;
args[j++] = program;
#endif
args[j++] = 0;
}
if (Xterm) {
if (display[0]) (*PetscErrorPrintf)("PETSC: Attaching %s to %s of pid %s on display %s on machine %s\n",Debugger,program,pid,display,hostname);
else (*PetscErrorPrintf)("PETSC: Attaching %s to %s on pid %s on %s\n",Debugger,program,pid,hostname);
if (execvp(args[0],(char**)args) < 0) {
perror("Unable to start debugger in xterm");
exit(0);
}
} else {
(*PetscErrorPrintf)("PETSC: Attaching %s to %s of pid %s on %s\n",Debugger,program,pid,hostname);
if (execvp(args[0],(char**)args) < 0) {
perror("Unable to start debugger");
exit(0);
}
}
}
} else { /* I am the child, continue with user code */
sleeptime = 10; /* default to sleep waiting for debugger */
ierr = PetscOptionsGetReal(NULL,"-debugger_pause",&sleeptime,NULL);CHKERRQ(ierr);
if (sleeptime < 0) sleeptime = -sleeptime;
#if defined(PETSC_NEED_DEBUGGER_NO_SLEEP)
/*
HP cannot attach process to sleeping debugger, hence count instead
*/
{
PetscReal x = 1.0;
int i =10000000;
while (i--) x++; /* cannot attach to sleeper */
}
#elif defined(PETSC_HAVE_SLEEP_RETURNS_EARLY)
/*
IBM sleep may return at anytime, hence must see if there is more time to sleep
*/
{
int left = sleeptime;
while (left > 0) left = PetscSleep(left) - 1;
}
#else
PetscSleep(sleeptime);
#endif
}
#endif
PetscFunctionReturn(0);
}
static PetscErrorCode MatPartitioningApply_Scotch(MatPartitioning part, IS * partitioning)
{
PetscErrorCode ierr;
int *parttab, *locals = PETSC_NULL, rank, i, size;
size_t j;
Mat mat = part->adj, matMPI, matSeq;
int nb_locals = mat->rmap->n;
Mat_MPIAdj *adj = (Mat_MPIAdj *) mat->data;
MatPartitioning_Scotch *scotch = (MatPartitioning_Scotch *) part->data;
PetscTruth flg;
#ifdef PETSC_HAVE_UNISTD_H
int fd_stdout, fd_pipe[2], count,err;
#endif
PetscFunctionBegin;
/* check if the matrix is sequential, use MatGetSubMatrices if necessary */
ierr = MPI_Comm_size(((PetscObject)mat)->comm, &size);CHKERRQ(ierr);
ierr = PetscTypeCompare((PetscObject) mat, MATMPIADJ, &flg);CHKERRQ(ierr);
if (size > 1) {
int M, N;
IS isrow, iscol;
Mat *A;
if (flg) {
SETERRQ(0, "Distributed matrix format MPIAdj is not supported for sequential partitioners");
}
PetscPrintf(((PetscObject)part)->comm, "Converting distributed matrix to sequential: this could be a performance loss\n");CHKERRQ(ierr);
ierr = MatGetSize(mat, &M, &N);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF, M, 0, 1, &isrow);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF, N, 0, 1, &iscol);CHKERRQ(ierr);
ierr = MatGetSubMatrices(mat, 1, &isrow, &iscol, MAT_INITIAL_MATRIX, &A);CHKERRQ(ierr);
matSeq = *A;
ierr = PetscFree(A);CHKERRQ(ierr);
ierr = ISDestroy(isrow);CHKERRQ(ierr);
ierr = ISDestroy(iscol);CHKERRQ(ierr);
} else
matSeq = mat;
/* convert the the matrix to MPIADJ type if necessary */
if (!flg) {
ierr = MatConvert(matSeq, MATMPIADJ, MAT_INITIAL_MATRIX, &matMPI);CHKERRQ(ierr);
} else {
matMPI = matSeq;
}
adj = (Mat_MPIAdj *) matMPI->data; /* finaly adj contains adjacency graph */
ierr = MPI_Comm_rank(((PetscObject)part)->comm, &rank);CHKERRQ(ierr);
{
/* definition of Scotch library arguments */
SCOTCH_Strat stratptr; /* scotch strategy */
SCOTCH_Graph grafptr; /* scotch graph */
#if defined(DOES_NOT_COMPILE_DUE_TO_BROKEN_INTERFACE)
int vertnbr = mat->rmap->N; /* number of vertices in full graph */
int *verttab = adj->i; /* start of edge list for each vertex */
int *edgetab = adj->j; /* edge list data */
int edgenbr = adj->nz; /* number of edges */
int *velotab = NULL; /* not used by petsc interface */
int *vlbltab = NULL;
int *edlotab = NULL;
int flagval = 3; /* (cf doc scotch no weight edge & vertices) */
#endif
int baseval = 0; /* 0 for C array indexing */
char strategy[256];
ierr = PetscMalloc((mat->rmap->N) * sizeof(int), &parttab);CHKERRQ(ierr);
/* redirect output to buffer scotch -> mesg_log */
#ifdef PETSC_HAVE_UNISTD_H
fd_stdout = dup(1);
pipe(fd_pipe);
close(1);
dup2(fd_pipe[1], 1);
ierr = PetscMalloc(SIZE_LOG * sizeof(char), &(scotch->mesg_log));CHKERRQ(ierr);
#endif
/* library call */
/* Construction of the scotch graph object */
ierr = SCOTCH_graphInit(&grafptr);
#if defined(DOES_NOT_COMPILE_DUE_TO_BROKEN_INTERFACE)
ierr = SCOTCH_graphBuild((SCOTCH_Graph *) &grafptr,
(const SCOTCH_Num) vertnbr,
(const SCOTCH_Num) verttab,
(const SCOTCH_Num *)velotab,
(const SCOTCH_Num *)vlbltab,
(const SCOTCH_Num *)edgenbr,
(const SCOTCH_Num *)edgetab,
(const SCOTCH_Num) edlotab,
(const SCOTCH_Num *)baseval,
(const SCOTCH_Num *)flagval);CHKERRQ(ierr);
#else
SETERRQ(PETSC_ERR_SUP,"Scotch interface currently broken");
#endif
ierr = SCOTCH_graphCheck(&grafptr);CHKERRQ(ierr);
/* Construction of the strategy */
if (scotch->strategy[0] != 0) {
ierr = PetscStrcpy(strategy, scotch->strategy);CHKERRQ(ierr);
} else {
PetscStrcpy(strategy, "b{strat=");
if (scotch->multilevel) {
/* PetscStrcat(strategy,"m{vert=");
sprintf(strategy+strlen(strategy),"%d",scotch->nbvtxcoarsed);
PetscStrcat(strategy,",asc="); */
sprintf(strategy, "b{strat=m{vert=%d,asc=",
scotch->nbvtxcoarsed);
} else
PetscStrcpy(strategy, "b{strat=");
switch (scotch->global_method) {
case MP_SCOTCH_GREEDY:
PetscStrcat(strategy, "h");
break;
case MP_SCOTCH_GPS:
PetscStrcat(strategy, "g");
break;
case MP_SCOTCH_GR_GPS:
PetscStrcat(strategy, "g|h");
}
switch (scotch->local_method) {
case MP_SCOTCH_KERNIGHAN_LIN:
if (scotch->multilevel)
PetscStrcat(strategy, ",low=f}");
else
PetscStrcat(strategy, " f");
break;
case MP_SCOTCH_NONE:
if (scotch->multilevel)
PetscStrcat(strategy, ",asc=x}");
default:
break;
}
PetscStrcat(strategy, " x}");
}
PetscPrintf(((PetscObject)part)->comm, "strategy=[%s]\n", strategy);
ierr = SCOTCH_stratInit(&stratptr);CHKERRQ(ierr);
/*
TODO: Correct this part
Commented because this doesn't exists anymore
ierr = SCOTCH_stratMap(&stratptr, strategy);CHKERRQ(ierr);
*/
/* check for option mapping */
if (!scotch->map) {
/* ********************************************
* *
* TODO: Correct this part *
* *
* Won't work with this tmp SCOTCH_Strat... *
* *
* I just modified it to make scotch compile, *
* to be able to use PaStiX... *
* *
**********************************************/
#if defined (DOES_NOT_COMPILE_DUE_TO_BROKEN_INTERFACE)
SCOTCH_Strat tmp;
ierr = SCOTCH_graphPart((const SCOTCH_Graph *)&grafptr,
(const SCOTCH_Num) &stratptr,
(const SCOTCH_Strat *)&tmp, /* The Argument changed from scotch 3.04 it was part->n, */
(SCOTCH_Num *) parttab);CHKERRQ(ierr);
#else
SETERRQ(PETSC_ERR_SUP,"Scotch interface currently broken");
#endif
ierr = PetscPrintf(PETSC_COMM_SELF, "Partition simple without mapping\n");
} else {
SCOTCH_Graph grafarch;
SCOTCH_Num *listtab;
SCOTCH_Num listnbr = 0;
SCOTCH_Arch archptr; /* file in scotch architecture format */
SCOTCH_Strat archstrat;
int arch_total_size, *parttab_tmp,err;
int cpt;
char buf[256];
FILE *file1, *file2;
char host_buf[256];
/* generate the graph that represents the arch */
file1 = fopen(scotch->arch, "r");
if (!file1) SETERRQ1(PETSC_ERR_FILE_OPEN, "Scotch: unable to open architecture file %s", scotch->arch);
ierr = SCOTCH_graphInit(&grafarch);CHKERRQ(ierr);
ierr = SCOTCH_graphLoad(&grafarch, file1, baseval, 3);CHKERRQ(ierr);
ierr = SCOTCH_graphCheck(&grafarch);CHKERRQ(ierr);
SCOTCH_graphSize(&grafarch, &arch_total_size, &cpt);
err = fclose(file1);
if (err) SETERRQ(PETSC_ERR_SYS,"fclose() failed on file");
printf("total size = %d\n", arch_total_size);
/* generate the list of nodes currently working */
ierr = PetscGetHostName(host_buf, 256);CHKERRQ(ierr);
ierr = PetscStrlen(host_buf, &j);CHKERRQ(ierr);
file2 = fopen(scotch->host_list, "r");
if (!file2) SETERRQ1(PETSC_ERR_FILE_OPEN, "Scotch: unable to open host list file %s", scotch->host_list);
i = -1;
flg = PETSC_FALSE;
while (!feof(file2) && !flg) {
i++;
fgets(buf, 256, file2);
PetscStrncmp(buf, host_buf, j, &flg);
}
err = fclose(file2);
if (err) SETERRQ(PETSC_ERR_SYS,"fclose() failed on file");
if (!flg) SETERRQ1(PETSC_ERR_LIB, "Scotch: unable to find '%s' in host list file", host_buf);
listnbr = size;
ierr = PetscMalloc(sizeof(SCOTCH_Num) * listnbr, &listtab);CHKERRQ(ierr);
ierr = MPI_Allgather(&i, 1, MPI_INT, listtab, 1, MPI_INT, ((PetscObject)part)->comm);CHKERRQ(ierr);
printf("listnbr = %d, listtab = ", listnbr);
for (i = 0; i < listnbr; i++)
printf("%d ", listtab[i]);
printf("\n");
err = fflush(stdout);
if (err) SETERRQ(PETSC_ERR_SYS,"fflush() failed on file");
ierr = SCOTCH_stratInit(&archstrat);CHKERRQ(ierr);
/**************************************************************
* *
* TODO: Correct this part *
* *
* Commented because this doesn't exists anymore *
* *
* ierr = SCOTCH_stratBipart(&archstrat, "fx");CHKERRQ(ierr); *
**************************************************************/
ierr = SCOTCH_archInit(&archptr);CHKERRQ(ierr);
ierr = SCOTCH_archBuild(&archptr, &grafarch, listnbr, listtab,
&archstrat);CHKERRQ(ierr);
ierr = PetscMalloc((mat->rmap->N) * sizeof(int), &parttab_tmp);CHKERRQ(ierr);
/************************************************************************************
* *
* TODO: Correct this part *
* *
* Commented because this doesn't exists anymore *
* *
* ierr = SCOTCH_mapInit(&mappptr, &grafptr, &archptr, parttab_tmp);CHKERRQ(ierr); *
* *
* ierr = SCOTCH_mapCompute(&mappptr, &stratptr);CHKERRQ(ierr); *
* *
* ierr = SCOTCH_mapView(&mappptr, stdout);CHKERRQ(ierr); *
************************************************************************************/
/* now we have to set in the real parttab at the good place */
/* because the ranks order are different than position in */
/* the arch graph */
for (i = 0; i < mat->rmap->N; i++) {
parttab[i] = parttab_tmp[i];
}
ierr = PetscFree(listtab);CHKERRQ(ierr);
SCOTCH_archExit(&archptr);
/*************************************************
* TODO: Correct this part *
* *
* Commented because this doesn't exists anymore *
* SCOTCH_mapExit(&mappptr); *
*************************************************/
SCOTCH_stratExit(&archstrat);
}
/* dump to mesg_log... */
#ifdef PETSC_HAVE_UNISTD_H
err = fflush(stdout);
if (err) SETERRQ(PETSC_ERR_SYS,"fflush() failed on stdout");
count = read(fd_pipe[0], scotch->mesg_log, (SIZE_LOG - 1) * sizeof(char));
if (count < 0)
count = 0;
scotch->mesg_log[count] = 0;
close(1);
dup2(fd_stdout, 1);
close(fd_stdout);
close(fd_pipe[0]);
close(fd_pipe[1]);
#endif
SCOTCH_graphExit(&grafptr);
SCOTCH_stratExit(&stratptr);
}
if (ierr)
SETERRQ(PETSC_ERR_LIB, scotch->mesg_log);
/* Creation of the index set */
ierr = MPI_Comm_rank(((PetscObject)part)->comm, &rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(((PetscObject)part)->comm, &size);CHKERRQ(ierr);
nb_locals = mat->rmap->N / size;
locals = parttab + rank * nb_locals;
if (rank < mat->rmap->N % size) {
nb_locals++;
locals += rank;
} else
locals += mat->rmap->N % size;
ierr = ISCreateGeneral(((PetscObject)part)->comm, nb_locals, locals, partitioning);CHKERRQ(ierr);
/* destroying old objects */
ierr = PetscFree(parttab);CHKERRQ(ierr);
if (matSeq != mat) {
ierr = MatDestroy(matSeq);CHKERRQ(ierr);
}
if (matMPI != mat) {
ierr = MatDestroy(matMPI);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@
DMPlexCreateGmsh - Create a DMPlex mesh from a Gmsh file viewer
Collective on comm
Input Parameters:
+ comm - The MPI communicator
. viewer - The Viewer associated with a Gmsh file
- interpolate - Create faces and edges in the mesh
Output Parameter:
. dm - The DM object representing the mesh
Note: http://www.geuz.org/gmsh/doc/texinfo/#MSH-ASCII-file-format
and http://www.geuz.org/gmsh/doc/texinfo/#MSH-binary-file-format
Level: beginner
.keywords: mesh,Gmsh
.seealso: DMPLEX, DMCreate()
@*/
PetscErrorCode DMPlexCreateGmsh(MPI_Comm comm, PetscViewer viewer, PetscBool interpolate, DM *dm)
{
PetscViewerType vtype;
GmshElement *gmsh_elem;
PetscSection coordSection;
Vec coordinates;
PetscScalar *coords, *coordsIn = NULL;
PetscInt dim = 0, coordSize, c, v, d, r, cell;
int i, numVertices = 0, numCells = 0, trueNumCells = 0, numRegions = 0, snum;
PetscMPIInt num_proc, rank;
char line[PETSC_MAX_PATH_LEN];
PetscBool match, binary, bswap = PETSC_FALSE;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &num_proc);CHKERRQ(ierr);
ierr = DMCreate(comm, dm);CHKERRQ(ierr);
ierr = DMSetType(*dm, DMPLEX);CHKERRQ(ierr);
ierr = PetscLogEventBegin(DMPLEX_CreateGmsh,*dm,0,0,0);CHKERRQ(ierr);
ierr = PetscViewerGetType(viewer, &vtype);CHKERRQ(ierr);
ierr = PetscStrcmp(vtype, PETSCVIEWERBINARY, &binary);CHKERRQ(ierr);
if (!rank || binary) {
PetscBool match;
int fileType, dataSize;
float version;
/* Read header */
ierr = PetscViewerRead(viewer, line, 1, NULL, PETSC_STRING);CHKERRQ(ierr);
ierr = PetscStrncmp(line, "$MeshFormat", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
ierr = PetscViewerRead(viewer, line, 3, NULL, PETSC_STRING);CHKERRQ(ierr);
snum = sscanf(line, "%f %d %d", &version, &fileType, &dataSize);
if (snum != 3) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unable to parse Gmsh file header: %s", line);
if (version < 2.0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Gmsh file must be at least version 2.0");
if (dataSize != sizeof(double)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Data size %d is not valid for a Gmsh file", dataSize);
if (binary) {
int checkInt;
ierr = PetscViewerRead(viewer, &checkInt, 1, NULL, PETSC_ENUM);CHKERRQ(ierr);
if (checkInt != 1) {
ierr = PetscByteSwap(&checkInt, PETSC_ENUM, 1);CHKERRQ(ierr);
if (checkInt == 1) bswap = PETSC_TRUE;
else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File type %d is not a valid Gmsh binary file", fileType);
}
} else if (fileType) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File type %d is not a valid Gmsh ASCII file", fileType);
ierr = PetscViewerRead(viewer, line, 1, NULL, PETSC_STRING);CHKERRQ(ierr);
ierr = PetscStrncmp(line, "$EndMeshFormat", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
/* OPTIONAL Read physical names */
ierr = PetscViewerRead(viewer, line, 1, NULL, PETSC_STRING);CHKERRQ(ierr);
ierr = PetscStrncmp(line, "$PhysicalNames", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (match) {
ierr = PetscViewerRead(viewer, line, 1, NULL, PETSC_STRING);CHKERRQ(ierr);
snum = sscanf(line, "%d", &numRegions);
if (snum != 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
for (r = 0; r < numRegions; ++r) {
PetscInt rdim, tag;
ierr = PetscViewerRead(viewer, &rdim, 1, NULL, PETSC_ENUM);CHKERRQ(ierr);
ierr = PetscViewerRead(viewer, &tag, 1, NULL, PETSC_ENUM);CHKERRQ(ierr);
ierr = PetscViewerRead(viewer, line, 1, NULL, PETSC_STRING);CHKERRQ(ierr);
}
ierr = PetscViewerRead(viewer, line, 1, NULL, PETSC_STRING);CHKERRQ(ierr);
ierr = PetscStrncmp(line, "$EndPhysicalNames", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
/* Initial read for vertex section */
ierr = PetscViewerRead(viewer, line, 1, NULL, PETSC_STRING);CHKERRQ(ierr);
}
/* Read vertices */
ierr = PetscStrncmp(line, "$Nodes", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
ierr = PetscViewerRead(viewer, line, 1, NULL, PETSC_STRING);CHKERRQ(ierr);
snum = sscanf(line, "%d", &numVertices);
if (snum != 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
ierr = PetscMalloc1(numVertices*3, &coordsIn);CHKERRQ(ierr);
if (binary) {
size_t doubleSize, intSize;
PetscInt elementSize;
char *buffer;
PetscScalar *baseptr;
ierr = PetscDataTypeGetSize(PETSC_ENUM, &intSize);CHKERRQ(ierr);
ierr = PetscDataTypeGetSize(PETSC_DOUBLE, &doubleSize);CHKERRQ(ierr);
elementSize = (intSize + 3*doubleSize);
ierr = PetscMalloc1(elementSize*numVertices, &buffer);CHKERRQ(ierr);
ierr = PetscViewerRead(viewer, buffer, elementSize*numVertices, NULL, PETSC_CHAR);CHKERRQ(ierr);
if (bswap) ierr = PetscByteSwap(buffer, PETSC_CHAR, elementSize*numVertices);CHKERRQ(ierr);
for (v = 0; v < numVertices; ++v) {
baseptr = ((PetscScalar*)(buffer+v*elementSize+intSize));
coordsIn[v*3+0] = baseptr[0];
coordsIn[v*3+1] = baseptr[1];
coordsIn[v*3+2] = baseptr[2];
}
ierr = PetscFree(buffer);CHKERRQ(ierr);
} else {
for (v = 0; v < numVertices; ++v) {
ierr = PetscViewerRead(viewer, &i, 1, NULL, PETSC_ENUM);CHKERRQ(ierr);
ierr = PetscViewerRead(viewer, &(coordsIn[v*3]), 3, NULL, PETSC_DOUBLE);CHKERRQ(ierr);
if (i != (int)v+1) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Invalid node number %d should be %d", i, v+1);
}
}
ierr = PetscViewerRead(viewer, line, 1, NULL, PETSC_STRING);CHKERRQ(ierr);;
ierr = PetscStrncmp(line, "$EndNodes", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
/* Read cells */
ierr = PetscViewerRead(viewer, line, 1, NULL, PETSC_STRING);CHKERRQ(ierr);;
ierr = PetscStrncmp(line, "$Elements", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
ierr = PetscViewerRead(viewer, line, 1, NULL, PETSC_STRING);CHKERRQ(ierr);;
snum = sscanf(line, "%d", &numCells);
if (snum != 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
}
if (!rank || binary) {
/* Gmsh elements can be of any dimension/co-dimension, so we need to traverse the
file contents multiple times to figure out the true number of cells and facets
in the given mesh. To make this more efficient we read the file contents only
once and store them in memory, while determining the true number of cells. */
ierr = DMPlexCreateGmsh_ReadElement(viewer, numCells, binary, bswap, &gmsh_elem);CHKERRQ(ierr);
for (trueNumCells=0, c = 0; c < numCells; ++c) {
if (gmsh_elem[c].dim > dim) {dim = gmsh_elem[c].dim; trueNumCells = 0;}
if (gmsh_elem[c].dim == dim) trueNumCells++;
}
ierr = PetscViewerRead(viewer, line, 1, NULL, PETSC_STRING);CHKERRQ(ierr);;
ierr = PetscStrncmp(line, "$EndElements", PETSC_MAX_PATH_LEN, &match);CHKERRQ(ierr);
if (!match) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "File is not a valid Gmsh file");
}
/* For binary we read on all ranks, but only build the plex on rank 0 */
if (binary && rank) {trueNumCells = 0; numVertices = 0;};
/* Allocate the cell-vertex mesh */
ierr = DMPlexSetChart(*dm, 0, trueNumCells+numVertices);CHKERRQ(ierr);
if (!rank) {
for (cell = 0, c = 0; c < numCells; ++c) {
if (gmsh_elem[c].dim == dim) {
ierr = DMPlexSetConeSize(*dm, cell, gmsh_elem[c].numNodes);CHKERRQ(ierr);
cell++;
}
}
}
ierr = DMSetUp(*dm);CHKERRQ(ierr);
/* Add cell-vertex connections */
if (!rank) {
PetscInt pcone[8], corner;
for (cell = 0, c = 0; c < numCells; ++c) {
if (gmsh_elem[c].dim == dim) {
for (corner = 0; corner < gmsh_elem[c].numNodes; ++corner) {
pcone[corner] = gmsh_elem[c].nodes[corner] + trueNumCells-1;
}
if (dim == 3) {
/* Tetrahedra are inverted */
if (gmsh_elem[c].numNodes == 4) {
PetscInt tmp = pcone[0];
pcone[0] = pcone[1];
pcone[1] = tmp;
}
/* Hexahedra are inverted */
if (gmsh_elem[c].numNodes == 8) {
PetscInt tmp = pcone[1];
pcone[1] = pcone[3];
pcone[3] = tmp;
}
}
ierr = DMPlexSetCone(*dm, cell, pcone);CHKERRQ(ierr);
cell++;
}
}
}
ierr = MPI_Bcast(&dim, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
ierr = DMSetDimension(*dm, dim);CHKERRQ(ierr);
ierr = DMPlexSymmetrize(*dm);CHKERRQ(ierr);
ierr = DMPlexStratify(*dm);CHKERRQ(ierr);
if (interpolate) {
DM idm = NULL;
ierr = DMPlexInterpolate(*dm, &idm);CHKERRQ(ierr);
ierr = DMDestroy(dm);CHKERRQ(ierr);
*dm = idm;
}
if (!rank) {
/* Apply boundary IDs by finding the relevant facets with vertex joins */
PetscInt pcone[8], corner, vStart, vEnd;
ierr = DMPlexGetDepthStratum(*dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
for (c = 0; c < numCells; ++c) {
if (gmsh_elem[c].dim == dim-1) {
PetscInt joinSize;
const PetscInt *join;
for (corner = 0; corner < gmsh_elem[c].numNodes; ++corner) {
pcone[corner] = gmsh_elem[c].nodes[corner] + vStart - 1;
}
ierr = DMPlexGetFullJoin(*dm, gmsh_elem[c].numNodes, (const PetscInt *) pcone, &joinSize, &join);CHKERRQ(ierr);
if (joinSize != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not determine Plex facet for element %d", gmsh_elem[c].id);
ierr = DMSetLabelValue(*dm, "Face Sets", join[0], gmsh_elem[c].tags[0]);CHKERRQ(ierr);
ierr = DMPlexRestoreJoin(*dm, gmsh_elem[c].numNodes, (const PetscInt *) pcone, &joinSize, &join);CHKERRQ(ierr);
}
}
/* Create cell sets */
for (cell = 0, c = 0; c < numCells; ++c) {
if (gmsh_elem[c].dim == dim) {
if (gmsh_elem[c].numTags > 0) {
ierr = DMSetLabelValue(*dm, "Cell Sets", cell, gmsh_elem[c].tags[0]);CHKERRQ(ierr);
cell++;
}
}
}
}
/* Read coordinates */
ierr = DMGetCoordinateSection(*dm, &coordSection);CHKERRQ(ierr);
ierr = PetscSectionSetNumFields(coordSection, 1);CHKERRQ(ierr);
ierr = PetscSectionSetFieldComponents(coordSection, 0, dim);CHKERRQ(ierr);
ierr = PetscSectionSetChart(coordSection, trueNumCells, trueNumCells + numVertices);CHKERRQ(ierr);
for (v = trueNumCells; v < trueNumCells+numVertices; ++v) {
ierr = PetscSectionSetDof(coordSection, v, dim);CHKERRQ(ierr);
ierr = PetscSectionSetFieldDof(coordSection, v, 0, dim);CHKERRQ(ierr);
}
ierr = PetscSectionSetUp(coordSection);CHKERRQ(ierr);
ierr = PetscSectionGetStorageSize(coordSection, &coordSize);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_SELF, &coordinates);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) coordinates, "coordinates");CHKERRQ(ierr);
ierr = VecSetSizes(coordinates, coordSize, PETSC_DETERMINE);CHKERRQ(ierr);
ierr = VecSetBlockSize(coordinates, dim);CHKERRQ(ierr);
ierr = VecSetType(coordinates, VECSTANDARD);CHKERRQ(ierr);
ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
if (!rank) {
for (v = 0; v < numVertices; ++v) {
for (d = 0; d < dim; ++d) {
coords[v*dim+d] = coordsIn[v*3+d];
}
}
}
ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
ierr = PetscFree(coordsIn);CHKERRQ(ierr);
ierr = DMSetCoordinatesLocal(*dm, coordinates);CHKERRQ(ierr);
ierr = VecDestroy(&coordinates);CHKERRQ(ierr);
/* Clean up intermediate storage */
if (!rank || binary) ierr = PetscFree(gmsh_elem);CHKERRQ(ierr);
ierr = PetscLogEventEnd(DMPLEX_CreateGmsh,*dm,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int getoptions(TAO_APPS *appsPtr)
{
// Haven't done break or reassign options
// -o only works for PVM
char options[16][10] = {"cache","alpha","pattern","search","tol","active","debug","profile",
"precision","inc","contract","step","min","max","nnls","eps"};
char strings[35][50]; // Don't need this many, but just being safe
char buffer[50]={0};
char tempstring[16];
int i;
int info;
PetscTruth flg,cacheisoff;
int length;
// Read in all options, store as strings. Later, copy strings to argv
appsPtr->argc=0;
// don't really need this one, but need to start strings at argv[1]
PetscStrcpy(strings[(appsPtr->argc)++],"executable");
// It's possible to use PetscStrcpy and PetscStrcat instead of snprintf
info = PetscOptionsGetString(0,"-apps_i",buffer, 49, &flg); CHKERRQ(info);
if (flg)
{
snprintf(strings[(appsPtr->argc)++],50,"-i%-s",buffer);
}
info = PetscOptionsGetString(0,"-apps_o",buffer, 49, &flg); CHKERRQ(info);
if (flg)
{
snprintf(strings[(appsPtr->argc)++],50,"-o%-s",buffer);
}
for (i=0;i<16;i++)
{
snprintf(tempstring,16,"-apps_%s",options[i]);
info = PetscOptionsGetString(0,tempstring,buffer,49,&flg); CHKERRQ(info);
if (flg)
{
snprintf(strings[(appsPtr->argc)++],50,"--%s=%-s",options[i],buffer);
// The TaoFevalMgr needs to know if the cache is to be used
// Assume it is to be used unless "-apps_cache false" is used
if (i==0)
{
info = PetscStrncmp(buffer,"false",5,&cacheisoff); CHKERRQ(info);
if (cacheisoff)
appsPtr->usecache = 0;
}
}
}
info = TaoMalloc(sizeof(char *)*appsPtr->argc, &appsPtr->argv); CHKERRQ(info);
for (i=0;i<appsPtr->argc; i++)
{
info = PetscStrlen(strings[i],&length); CHKERRQ(info);
info = TaoMalloc(sizeof(char)*length+1, &appsPtr->argv[i]); CHKERRQ(info);
info = PetscStrncpy(appsPtr->argv[i],strings[i],length); CHKERRQ(info);
}
TaoFunctionReturn(0);
}
/*@C
PetscFileRetrieve - Obtains a library from a URL or compressed
and copies into local disk space as uncompressed.
Collective on MPI_Comm
Input Parameter:
+ comm - processors accessing the library
. libname - name of library, including entire URL (with or without .gz)
- llen - length of llibname
Output Parameter:
+ llibname - name of local copy of library
- found - if found and retrieved the file
Level: developer
@*/
PetscErrorCode PetscFileRetrieve(MPI_Comm comm,const char libname[],char llibname[],size_t llen,PetscBool *found)
{
char buf[1024],tmpdir[PETSC_MAX_PATH_LEN],urlget[PETSC_MAX_PATH_LEN],*par;
const char *pdir;
FILE *fp;
PetscErrorCode ierr;
int i;
PetscMPIInt rank;
size_t len = 0;
PetscBool flg1,flg2,flg3,sharedtmp,exists;
#if defined(PETSC_HAVE_POPEN)
int rval;
#endif
PetscFunctionBegin;
*found = PETSC_FALSE;
/* if file does not have an ftp:// or http:// or .gz then need not process file */
ierr = PetscStrstr(libname,".gz",&par);CHKERRQ(ierr);
if (par) {ierr = PetscStrlen(par,&len);CHKERRQ(ierr);}
ierr = PetscStrncmp(libname,"ftp://",6,&flg1);CHKERRQ(ierr);
ierr = PetscStrncmp(libname,"http://",7,&flg2);CHKERRQ(ierr);
ierr = PetscStrncmp(libname,"file://",7,&flg3);CHKERRQ(ierr);
if (!flg1 && !flg2 && !flg3 && (!par || len != 3)) {
ierr = PetscStrncpy(llibname,libname,llen);CHKERRQ(ierr);
ierr = PetscTestFile(libname,'r',found);CHKERRQ(ierr);
if (*found) {
ierr = PetscInfo1(NULL,"Found file %s\n",libname);CHKERRQ(ierr);
} else {
ierr = PetscInfo1(NULL,"Did not find file %s\n",libname);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
if (par && len == 3){
size_t llen;
ierr = PetscStrlen(libname,&llen);CHKERRQ(ierr);
ierr = PetscStrncpy(llibname,libname,llen);CHKERRQ(ierr);
llibname[llen-len] = 0;
ierr = PetscTestFile(llibname,'r',found);CHKERRQ(ierr);
if (*found) {
ierr = PetscInfo1(NULL,"Found uncompressed version of file %s\n",llibname);CHKERRQ(ierr);
PetscFunctionReturn(0);
} else {
ierr = PetscInfo1(NULL,"Did not find uncompressed version of file %s\n",libname);CHKERRQ(ierr);
}
}
/* Determine if all processors share a common /tmp */
ierr = PetscSharedTmp(comm,&sharedtmp);CHKERRQ(ierr);
ierr = PetscOptionsGetenv(comm,"PETSC_TMP",tmpdir,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
if (!rank || !sharedtmp) {
/* Construct the script to get URL file */
ierr = PetscGetPetscDir(&pdir);CHKERRQ(ierr);
ierr = PetscStrcpy(urlget,pdir);CHKERRQ(ierr);
ierr = PetscStrcat(urlget,"/bin/urlget");CHKERRQ(ierr);
ierr = PetscTestFile(urlget,'r',&exists);CHKERRQ(ierr);
if (!exists) {
ierr = PetscTestFile("urlget",'r',&exists);CHKERRQ(ierr);
if (!exists) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot locate PETSc script urlget in %s or current directory",urlget);
ierr = PetscStrcpy(urlget,"urlget");CHKERRQ(ierr);
}
ierr = PetscStrcat(urlget," ");CHKERRQ(ierr);
/* are we using an alternative /tmp? */
if (flg1) {
ierr = PetscStrcat(urlget,"-tmp ");CHKERRQ(ierr);
ierr = PetscStrcat(urlget,tmpdir);CHKERRQ(ierr);
ierr = PetscStrcat(urlget," ");CHKERRQ(ierr);
}
ierr = PetscStrcat(urlget,libname);CHKERRQ(ierr);
ierr = PetscStrcat(urlget," 2>&1 ");CHKERRQ(ierr);
#if defined(PETSC_HAVE_POPEN)
ierr = PetscPOpen(PETSC_COMM_SELF,NULL,urlget,"r",&fp);CHKERRQ(ierr);
#else
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
#endif
if (!fgets(buf,1024,fp)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"No output from ${PETSC_DIR}/bin/urlget in getting file %s",libname);
ierr = PetscInfo1(0,"Message back from urlget: %s\n",buf);CHKERRQ(ierr);
ierr = PetscStrncmp(buf,"Error",5,&flg1);CHKERRQ(ierr);
ierr = PetscStrncmp(buf,"Traceback",9,&flg2);CHKERRQ(ierr);
#if defined(PETSC_HAVE_POPEN)
ierr = PetscPClose(PETSC_COMM_SELF,fp,&rval);CHKERRQ(ierr);
#endif
if (flg1 || flg2) *found = PETSC_FALSE;
else {
*found = PETSC_TRUE;
/* Check for \n and make it 0 */
for (i=0; i<1024; i++) {
if (buf[i] == '\n') {
buf[i] = 0;
break;
}
}
ierr = PetscStrncpy(llibname,buf,llen);CHKERRQ(ierr);
}
}
if (sharedtmp) { /* send library name to all processors */
ierr = MPI_Bcast(found,1,MPIU_BOOL,0,comm);CHKERRQ(ierr);
if (*found) {
ierr = MPI_Bcast(llibname,llen,MPI_CHAR,0,comm);CHKERRQ(ierr);
ierr = MPI_Bcast(found,1,MPIU_BOOL,0,comm);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
