示例#1
0
/*@C
  PetscViewerMathematicaGetVector - Retrieve a vector from Mathematica

  Input Parameter:
. viewer - The Mathematica viewer

  Output Parameter:
. v      - The vector

  Level: intermediate

.keywords PetscViewer, Mathematica, vector
.seealso VecView(), PetscViewerMathematicaPutVector()
@*/
PetscErrorCode  PetscViewerMathematicaGetVector(PetscViewer viewer, Vec v)
{
    PetscViewer_Mathematica *vmath = (PetscViewer_Mathematica*) viewer->data;
    MLINK                   link;   /* The link to Mathematica */
    char                    *name;
    PetscScalar             *mArray,*array;
    long                    mSize;
    int                     n;
    PetscErrorCode          ierr;

    PetscFunctionBegin;
    PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID,1);
    PetscValidHeaderSpecific(v,      VEC_CLASSID,2);

    /* Determine the object name */
    if (!vmath->objName) name = "vec";
    else                 name = (char*) vmath->objName;

    link = vmath->link;
    ierr = VecGetLocalSize(v, &n);
    CHKERRQ(ierr);
    ierr = VecGetArray(v, &array);
    CHKERRQ(ierr);
    MLPutFunction(link, "EvaluatePacket", 1);
    MLPutSymbol(link, name);
    MLEndPacket(link);
    ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT);
    CHKERRQ(ierr);
    MLGetRealList(link, &mArray, &mSize);
    if (n != mSize) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG, "Incompatible vector sizes %d %d",n,mSize);
    ierr = PetscMemcpy(array, mArray, mSize * sizeof(double));
    CHKERRQ(ierr);
    MLDisownRealList(link, mArray, mSize);
    ierr = VecRestoreArray(v, &array);
    CHKERRQ(ierr);
    PetscFunctionReturn(0);
}
示例#2
0
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);
}
示例#3
0
void clean_up_ode(){
    clean_up_ode_c();
    MLPutSymbol(stdlink, "Null");
    MLEndPacket(stdlink);
    MLFlush(stdlink);
}
示例#4
0
void init_A(double* ps, long ps_len, double* opts, long opts_len){
    init_a_c(ps, (int*)&ps_len, opts);
    MLPutSymbol(stdlink, "Null");
    MLEndPacket(stdlink);
    MLFlush(stdlink);
}