bool MLAttempt(int func){
if (!func) {
char err_msg[150];
sprintf(err_msg, "Message[GrapheneToolsLink::error,\"%.76s\"]", MLErrorMessage(stdlink));
MLClearError(stdlink); MLNewPacket(stdlink); MLEvaluate(stdlink, err_msg);
MLNextPacket(stdlink); MLNewPacket(stdlink); MLPutSymbol(stdlink, "$Failed");
return false;
}
return true;
}
PetscErrorCode PetscViewerMathematicaPutMatrix(PetscViewer viewer, int m, int n, PetscReal *a)
{
PetscViewer_Mathematica *vmath = (PetscViewer_Mathematica*) viewer->data;
MLINK link = vmath->link; /* The link to Mathematica */
char *name;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Determine the object name */
if (!vmath->objName) name = "mat";
else name = (char*) vmath->objName;
/* Send the dense matrix object */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "Set", 2);
MLPutSymbol(link, name);
MLPutFunction(link, "Transpose", 1);
MLPutFunction(link, "Partition", 2);
MLPutRealList(link, a, m*n);
MLPutInteger(link, m);
MLEndPacket(link);
/* Skip packets until ReturnPacket */
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
/* Skip ReturnPacket */
MLNewPacket(link);
PetscFunctionReturn(0);
}
/*@C
PetscViewerMathematicaPutVector - Send a vector to Mathematica
Input Parameters:
+ viewer - The Mathematica viewer
- v - The vector
Level: intermediate
.keywords PetscViewer, Mathematica, vector
.seealso VecView(), PetscViewerMathematicaGetVector()
@*/
PetscErrorCode PetscViewerMathematicaPutVector(PetscViewer viewer, Vec v)
{
PetscViewer_Mathematica *vmath = (PetscViewer_Mathematica*) viewer->data;
MLINK link = vmath->link; /* The link to Mathematica */
char *name;
PetscScalar *array;
int n;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Determine the object name */
if (!vmath->objName) name = "vec";
else name = (char*) vmath->objName;
ierr = VecGetLocalSize(v, &n);
CHKERRQ(ierr);
ierr = VecGetArray(v, &array);
CHKERRQ(ierr);
/* Send the Vector object */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "Set", 2);
MLPutSymbol(link, name);
MLPutRealList(link, array, n);
MLEndPacket(link);
/* Skip packets until ReturnPacket */
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
/* Skip ReturnPacket */
MLNewPacket(link);
ierr = VecRestoreArray(v, &array);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void NCGBShutDownMma() {
GBStream << "> We are in the command NCGBShutDownMma\n"; GBStream.flush();
// New packet covered by ncgbfrontendtm.c
// nothing here
if(!MLNewPacket(stdlink)) DBG();
if(!MLPutSymbol(stdlink,"Null")) DBG();
GBStream << "< We are done with the command NCGBShutDownMma\n"; GBStream.flush();
};
/*@C
PetscViewerMathematicaSkipPackets - Discard packets sent by Mathematica until a certain packet type is received
Input Parameters:
. viewer - The Mathematica viewer
. type - The packet type to search for, e.g RETURNPKT
Level: advanced
.keywords PetscViewer, Mathematica, packets
.seealso PetscViewerMathematicaSetName(), PetscViewerMathematicaGetVector()
@*/
PetscErrorCode PetscViewerMathematicaSkipPackets(PetscViewer viewer, int type)
{
PetscViewer_Mathematica *vmath = (PetscViewer_Mathematica*) viewer->data;
MLINK link = vmath->link; /* The link to Mathematica */
int pkt; /* The packet type */
PetscFunctionBegin;
while ((pkt = MLNextPacket(link)) && (pkt != type)) MLNewPacket(link);
if (!pkt) {
MLClearError(link);
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB, (char*) MLErrorMessage(link));
}
PetscFunctionReturn(0);
}
void NCGBStartUpMma() {
GBStream << "> We are in the command NCGBStartUpMma\n"; GBStream.flush();
// New packet covered by ncgbfrontendtm.c
symbolGB name;
delete s_mma_source_p;
delete s_mma_sink_p;
s_mma_source_p = new MmaSource(stdlink);
s_mma_sink_p = new MmaSink(stdlink);
char * string = new char[1];
string[0] = '\n';
if(!MLNewPacket(stdlink)) DBG();
if(!MLPutSymbol(stdlink,"Null")) DBG();
// printAllCommands();
GBStream << "< We are done with the command NCGBStartUpMma\n"; GBStream.flush();
};
PetscErrorCode PetscViewerMathematicaPutCSRMatrix(PetscViewer viewer, int m, int n, int *i, int *j, PetscReal *a)
{
PetscViewer_Mathematica *vmath = (PetscViewer_Mathematica*) viewer->data;
MLINK link = vmath->link; /* The link to Mathematica */
const char *symbol;
char *name;
PetscBool match;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Determine the object name */
if (!vmath->objName) name = "mat";
else name = (char*) vmath->objName;
/* Make sure Mathematica recognizes sparse matrices */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "Needs", 1);
MLPutString(link, "LinearAlgebra`CSRMatrix`");
MLEndPacket(link);
/* Skip packets until ReturnPacket */
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
/* Skip ReturnPacket */
MLNewPacket(link);
/* Send the CSRMatrix object */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "Set", 2);
MLPutSymbol(link, name);
MLPutFunction(link, "CSRMatrix", 5);
MLPutInteger(link, m);
MLPutInteger(link, n);
MLPutFunction(link, "Plus", 2);
MLPutIntegerList(link, i, m+1);
MLPutInteger(link, 1);
MLPutFunction(link, "Plus", 2);
MLPutIntegerList(link, j, i[m]);
MLPutInteger(link, 1);
MLPutRealList(link, a, i[m]);
MLEndPacket(link);
/* Skip packets until ReturnPacket */
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
/* Skip ReturnPacket */
MLNewPacket(link);
/* Check that matrix is valid */
MLPutFunction(link, "EvaluatePacket", 1);
MLPutFunction(link, "ValidQ", 1);
MLPutSymbol(link, name);
MLEndPacket(link);
ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
CHKERRQ(ierr);
MLGetSymbol(link, &symbol);
ierr = PetscStrcmp("True", (char*) symbol, &match);
CHKERRQ(ierr);
if (!match) {
MLDisownSymbol(link, symbol);
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB, "Invalid CSR matrix in Mathematica");
}
MLDisownSymbol(link, symbol);
/* Skip ReturnPacket */
MLNewPacket(link);
PetscFunctionReturn(0);
}
static int processPackets(MLINK link)
{
int packetType;
int loop = 1;
int errors = 0;
int ierr;
PetscFunctionBegin;
while (loop) {
while ((packetType = MLNextPacket(link)) && (packetType != RETURNPKT)) {
switch (packetType) {
case BEGINDLGPKT:
printf("Begin dialog packet\n");
break;
case CALLPKT:
printf("Call packet\n");
break;
case DISPLAYPKT:
printf("Display packet\n");
break;
case DISPLAYENDPKT:
printf("Display end packet\n");
break;
case ENDDLGPKT:
printf("End dialog packet\n");
break;
case ENTERTEXTPKT:
printf("Enter text packet\n");
break;
case ENTEREXPRPKT:
printf("Enter expression packet\n");
break;
case EVALUATEPKT:
printf("Evaluate packet\n");
break;
case INPUTPKT:
printf("Input packet\n");
break;
case INPUTNAMEPKT:
printf("Input name packet\n");
break;
case INPUTSTRPKT:
printf("Input string packet\n");
break;
case MENUPKT:
printf("Menu packet\n");
break;
case MESSAGEPKT:
printf("Message packet\n");
break;
case OUTPUTNAMEPKT:
printf("Output name packet\n");
break;
case RESUMEPKT:
printf("Resume packet\n");
break;
case RETURNTEXTPKT:
printf("Return text packet\n");
break;
case RETURNEXPRPKT:
printf("Return expression packet\n");
break;
case SUSPENDPKT:
printf("Suspend packet\n");
break;
case SYNTAXPKT:
printf("Syntax packet\n");
break;
case TEXTPKT:
printf("Text packet\n");
break;
}
MLNewPacket(link);
}
/* Got a Return packet */
if (!packetType) {
MLClearError(link);
printf("ERROR: %s\n", (char*) MLErrorMessage(link));
errors++;
} else if (packetType == RETURNPKT) {
ierr = processPacket(link, 0);
if (ierr == 1) CHKERRQ(ierr);
if (ierr == 2) loop = 0;
} else {
fprintf(stderr, "Invalid packet type %d\n", packetType);
loop = 0;
}
if (errors > 10) loop = 0;
}
PetscFunctionReturn(0);
}