void EchoIt(MLINK stdlink,MLINK ml,bool b) {
bool inCompound = false;
int i;
double d;
char * s = 0;
char * t = 0;
long m,n;
switch(MLGetType(stdlink)) {
case MLTKINT;
MLGetInteger(stdlink,&i);
MLPutInteger(ml,i);
break;
case MLTKSYMB;
MLGetSymbol(stdlink,&s);
t = new char[strlen(s)+4];
strcpy(t,s);
strcat(t,"MXS");
MLPutSymbol(ml,t);
delete [] t;
MLDisownSymbol(stdlink,s);
break;
case MLTKSTR;
MLGetString(stdlink,&s);
MLPutString(ml,s);
MLDisownString(stdlink,s);
break;
case MLTKINT;
MLGetInteger(stdlink,&i);
MLPutInteger(ml,i);
break;
case MLTKFUNC;
MLGetFunction(stdlink,&s,m);
strcpy(t,s);
strcat(t,"MXS");
if(strcmp(s,"CompoundExpression")==0 && b) {
inCompound = true;
MLPutFunction(ml,t,2*m);
} else {
MLPutFunction(ml,t,m);
};
delete [] t;
for(long n=1;n<=m;++n) {
if(inCompound) {
MLPutFunction(ml,"Print",4L);
MLPutString(ml,"Function:");
MLPutString(ml,s);
MLPutString(ml," ");
MLPutInteger(ml,s_number);
++s_number;
};
EchoIt(stdlink,ml,b);
};
inCompound = false;
break;
default:
DBG();
break;
};
};
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 processPacket(MLINK link, int indent)
{
static int isHead = 0;
int tokenType = MLGetNext(link);
int ierr;
PetscFunctionBegin;
ierr = printIndent(indent);CHKERRQ(ierr);
switch (tokenType) {
case MLTKFUNC:
{
long numArguments;
int arg;
printf("Function:\n");
MLGetArgCount(link, &numArguments);
/* Process head */
printf(" Head:\n");
isHead = 1;
ierr = processPacket(link, indent+4);
if (ierr) PetscFunctionReturn(ierr);
isHead = 0;
/* Process arguments */
printf(" Arguments:\n");
for (arg = 0; arg < numArguments; arg++) {
ierr = processPacket(link, indent+4);CHKERRQ(ierr);
}
}
break;
case MLTKSYM:
{
const char *symbol;
MLGetSymbol(link, &symbol);
printf("Symbol: %s\n", symbol);
if (isHead && !strcmp(symbol, "Shutdown")) {
MLDisownSymbol(link, symbol);
PetscFunctionReturn(2);
}
MLDisownSymbol(link, symbol);
}
break;
case MLTKINT:
{
int i;
MLGetInteger(link, &i);
printf("Integer: %d\n", i);
}
break;
case MLTKREAL:
{
double r;
MLGetReal(link, &r);
printf("Real: %g\n", r);
}
break;
case MLTKSTR:
{
const char *string;
MLGetString(link, &string);
printf("String: %s\n", string);
MLDisownString(link, string);
}
break;
default:
printf("Unknown code %d\n", tokenType);
MLClearError(link);
fprintf(stderr, "ERROR: %s\n", (char*) MLErrorMessage(link));
PetscFunctionReturn(1);
}
PetscFunctionReturn(0);
}
