/*--------------------------------------------------------------------------*/
int sci_scinotes(char *fname, unsigned long fname_len)
{
SciErr sciErr;
CheckRhs(0, 3);
CheckLhs(0, 1);
if (Rhs == 0)
{
try
{
callSciNotesW(NULL, 0);
}
catch (GiwsException::JniCallMethodException exception)
{
Scierror(999, "%s: %s\n", fname, exception.getJavaDescription().c_str());
}
catch (GiwsException::JniException exception)
{
Scierror(999, "%s: %s\n", fname, exception.whatStr().c_str());
}
}
else
{
int m1 = 0, n1 = 0;
int *piAddressVarOne = NULL;
wchar_t **pStVarOne = NULL;
int *lenStVarOne = NULL;
int i = 0;
int iType1 = 0;
char *functionName = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarOne, &iType1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (iType1 != sci_strings)
{
Scierror(999, _("%s: Wrong type for argument #%d: String matrix expected.\n"), fname, 1);
return 0;
}
/* get dimensions */
sciErr = getMatrixOfWideString(pvApiCtx, piAddressVarOne, &m1, &n1, lenStVarOne, NULL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
lenStVarOne = (int *)MALLOC(sizeof(int) * (m1 * n1));
if (lenStVarOne == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
/* get lengths */
sciErr = getMatrixOfWideString(pvApiCtx, piAddressVarOne, &m1, &n1, lenStVarOne, pStVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
FREE(lenStVarOne);
return 0;
}
pStVarOne = (wchar_t **) MALLOC(sizeof(wchar_t *) * (m1 * n1));
if (pStVarOne == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
FREE(lenStVarOne);
return 0;
}
for (i = 0; i < m1 * n1; i++)
{
pStVarOne[i] = (wchar_t *) MALLOC(sizeof(wchar_t) * (lenStVarOne[i] + 1));
if (pStVarOne[i] == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
for (; i >= 0; i--)
{
FREE(pStVarOne[i]);
}
FREE(pStVarOne);
FREE(lenStVarOne);
return 0;
}
}
/* get strings */
sciErr = getMatrixOfWideString(pvApiCtx, piAddressVarOne, &m1, &n1, lenStVarOne, pStVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
if (Rhs >= 2) //get line numbers
{
int *piAddressVarTwo = NULL;
int m2 = 0, n2 = 0;
double *pdblVarTwo = NULL;
int iType2 = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarTwo, &iType2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
if (iType2 != sci_matrix && iType2 != sci_strings)
{
Scierror(999, _("%s: Wrong type for argument #%d: Real matrix or \'readonly\' expected.\n"), fname, 2);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
if (iType2 == sci_strings)
{
/* get dimensions */
wchar_t **pStVarTwo = NULL;
int *lenStVarTwo = NULL;
sciErr = getMatrixOfWideString(pvApiCtx, piAddressVarTwo, &m2, &n2, lenStVarTwo, NULL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
if (m2 != 1 || n2 != 1)
{
Scierror(999, _("%s: Wrong type for argument #%d: Real matrix or \'readonly\' expected.\n"), fname, 2);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
lenStVarTwo = (int *)MALLOC(sizeof(int));
if (lenStVarTwo == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
/* get lengths */
sciErr = getMatrixOfWideString(pvApiCtx, piAddressVarTwo, &m2, &n2, lenStVarTwo, pStVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
FREE(lenStVarTwo);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
pStVarTwo = (wchar_t **) MALLOC(sizeof(wchar_t *));
if (pStVarTwo == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
FREE(lenStVarTwo);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
pStVarTwo[0] = (wchar_t *) MALLOC(sizeof(wchar_t) * (lenStVarTwo[0] + 1));
if (pStVarTwo[0] == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
FREE(pStVarTwo);
FREE(lenStVarTwo);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
/* get strings */
sciErr = getMatrixOfWideString(pvApiCtx, piAddressVarTwo, &m2, &n2, lenStVarTwo, pStVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
FREE(pStVarTwo);
FREE(lenStVarTwo);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
try
{
callSciNotesWWithOption(pStVarOne, pStVarTwo, m1 * n1);
}
catch (GiwsException::JniCallMethodException exception)
{
Scierror(999, "%s: %s\n", fname, exception.getJavaDescription().c_str());
FREE(pStVarTwo);
FREE(lenStVarTwo);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
catch (GiwsException::JniException exception)
{
Scierror(999, "%s: %s\n", fname, exception.whatStr().c_str());
FREE(pStVarTwo);
FREE(lenStVarTwo);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
freeArrayOfWideString(pStVarTwo, 1);
FREE(lenStVarTwo);
}
else
{
if (isVarComplex(pvApiCtx, piAddressVarTwo) == 1)
{
Scierror(999, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), fname, 2);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo, &m2, &n2, &pdblVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
if (m2 * n2 != m1 * n1)
{
Scierror(999, _("%s: Wrong size for input arguments #%d and #%d: Same dimensions expected.\n"), fname, 1, 2);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
if (Rhs == 3)
{
int *piAddressVarThree = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddressVarThree);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 3);
return 0;
}
if (!isStringType(pvApiCtx, piAddressVarThree))
{
Scierror(999, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 3);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
int ret = getAllocatedSingleString(pvApiCtx, piAddressVarThree, &functionName);
if (ret)
{
Scierror(999, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 3);
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
return 0;
}
}
try
{
callSciNotesWWithLineNumberAndFunction(pStVarOne, pdblVarTwo, functionName, m1 * n1);
}
catch (GiwsException::JniCallMethodException exception)
{
Scierror(999, "%s: %s\n", fname, exception.getJavaDescription().c_str());
}
catch (GiwsException::JniException exception)
{
Scierror(999, "%s: %s\n", fname, exception.whatStr().c_str());
}
}
}
else
{
try
{
callSciNotesW(pStVarOne, m1 * n1);
}
catch (GiwsException::JniCallMethodException exception)
{
Scierror(999, "%s: %s\n", fname, exception.getJavaDescription().c_str());
}
catch (GiwsException::JniException exception)
{
Scierror(999, "%s: %s\n", fname, exception.whatStr().c_str());
}
}
freeArrayOfWideString(pStVarOne, m1 * n1);
FREE(lenStVarOne);
if (functionName)
{
freeAllocatedSingleString(functionName);
}
}
LhsVar(1) = 0;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_xpoly(char * fname, unsigned long fname_len)
{
SciErr sciErr;
int* piAddrl1 = NULL;
double* l1 = NULL;
int* piAddrl2 = NULL;
double* l2 = NULL;
int* piAddrl3 = NULL;
char* l3 = NULL;
int* piAddrl4 = NULL;
double* l4 = NULL;
char *psubwinUID = NULL;
char* pobjUID = NULL;
int m1 = 0, n1 = 0, m2 = 0 , n2 = 0, m4 = 0, n4 = 0, close = 0, mn2 = 0;
long hdl = 0;/* NG */
int mark = 0;/* NG */
int markMode = 0;
int lineMode = 0;
int foreground = 0;
int iTmp = 0;
int* piTmp = &iTmp;
CheckInputArgument(pvApiCtx, 2, 4);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrl1, &m1, &n1, &l1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 1);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrl2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrl2, &m2, &n2, &l2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 2);
return 1;
}
//CheckSameDims
if (m1 != m2 || n1 != n2)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d-by-%d matrix expected.\n"), fname, 1, m1, n1);
return 1;
}
mn2 = m2 * n2;
if (nbInputArgument(pvApiCtx) >= 3)
{
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddrl3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 3.
if (getAllocatedSingleString(pvApiCtx, piAddrl3, &l3))
{
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 3);
return 1;
}
if (strcmp((l3), "lines") == 0)
{
strcpy(C2F(cha1).buf, "xlines");
mark = 1; /* NG */
}
else if (strcmp((l3), "marks") == 0)
{
strcpy(C2F(cha1).buf, "xmarks");
mark = 0; /* NG */
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), fname, 3, "lines", "marks");
return 0;
}
}
else
{
strcpy(C2F(cha1).buf, "xlines");
mark = 1; /* NG */
}
if (nbInputArgument(pvApiCtx) >= 4)
{
sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddrl4);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 4.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrl4, &m4, &n4, &l4);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 4);
return 1;
}
//CheckScalar
if (m4 != 1 || n4 != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, 4);
return 1;
}
close = (int) * (l4);
}
/* NG beg */
psubwinUID = (char*)getOrCreateDefaultSubwin();
Objpoly ((l1), (l2), mn2, close, mark, &hdl);
pobjUID = (char*)getObjectFromHandle(hdl); /* the polyline newly created */
setGraphicObjectRelationship(psubwinUID, pobjUID);
/*
* The contour properties set calls below were
* already present and have been updated for the MVC.
*/
if (mark == 0)
{
/* marks are enabled but markstyle & foreground
is determined by parents' markstyle & foreground */
markMode = 1;
lineMode = 0;
getGraphicObjectProperty(psubwinUID, __GO_MARK_STYLE__, jni_int, (void**)&piTmp);
setGraphicObjectProperty(pobjUID, __GO_MARK_STYLE__, piTmp, jni_int, 1);
}
else
{
markMode = 0;
lineMode = 1;
getGraphicObjectProperty(psubwinUID, __GO_LINE_STYLE__, jni_int, (void**)&piTmp);
sciSetLineStyle(pobjUID, iTmp);
}
getGraphicObjectProperty(psubwinUID, __GO_LINE_COLOR__, jni_int, (void**)&piTmp);
foreground = iTmp;
setGraphicObjectProperty(pobjUID, __GO_LINE_COLOR__, &foreground, jni_int, 1);
setGraphicObjectProperty(pobjUID, __GO_MARK_MODE__, &markMode, jni_bool, 1);
setGraphicObjectProperty(pobjUID, __GO_LINE_MODE__, &lineMode, jni_bool, 1);
/* NG end */
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
freeAllocatedSingleString(l3);
return 0;
}
/*--------------------------------------------------------------------------*/
SciErr getProcessMode(void *_pvCtx, int _iPos, int *_piAddRef, int *_piMode)
{
SciErr sciErr;
sciErr.iErr = 0;
sciErr.iMsgCount = 0;
int iRows1 = 0;
int iCols1 = 0;
int iRows2 = 0;
int iCols2 = 0;
int iType2 = 0;
int iMode = 0;
int *piAddr2 = NULL;
sciErr = getVarDimension(_pvCtx, _piAddRef, &iRows1, &iCols1);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_PROCESSMODE, _("%s: Unable to get argument dimension"), "getProcessMode");
return sciErr;
}
//sciprint("getProcessMode ->");
sciErr = getinternalVarAddress(_pvCtx, _iPos, &piAddr2);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_PROCESSMODE, _("%s: Unable to get variable address"), "getProcessMode");
return sciErr;
}
sciErr = getVarType(_pvCtx, piAddr2, &iType2);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_PROCESSMODE, _("%s: Unable to get argument type"), "getProcessMode");
return sciErr;
}
if (iType2 == sci_matrix && !isVarComplex(_pvCtx, piAddr2))
{
double *pdblReal2 = NULL;
sciErr = getMatrixOfDouble(_pvCtx, piAddr2, &iRows2, &iCols2, &pdblReal2);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_PROCESSMODE, _("%s: Unable to get argument data"), "getProcessMode");
return sciErr;
}
if (iRows2 != 1 || iCols2 != 1)
{
addErrorMessage(&sciErr, API_ERROR_GET_PROCESSMODE, _("%s: Wrong size for argument %d: (%d,%d) expected.\n"), "getProcessMode", _iPos, 1,
1);
return sciErr;
}
iMode = (int)pdblReal2[0];
}
else if (iType2 == sci_strings)
{
int iLen = 0;
char *pstMode[1] = { "" };
sciErr = getVarDimension(_pvCtx, piAddr2, &iRows2, &iCols2);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_PROCESSMODE, _("%s: Unable to get argument dimension"), "getProcessMode");
return sciErr;
}
if (iRows2 != 1 || iCols2 != 1)
{
addErrorMessage(&sciErr, API_ERROR_GET_PROCESSMODE, _("%s: Wrong size for argument %d: (%d,%d) expected.\n"), "getProcessMode", _iPos, 1,
1);
return sciErr;
}
sciErr = getMatrixOfString(_pvCtx, piAddr2, &iRows2, &iCols2, &iLen, NULL);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_PROCESSMODE, _("%s: Unable to get argument data"), "getProcessMode");
return sciErr;
}
pstMode[0] = (char *)MALLOC(sizeof(char) * (iLen + 1)); //+1 for null termination
sciErr = getMatrixOfString(_pvCtx, piAddr2, &iRows2, &iCols2, &iLen, pstMode);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_PROCESSMODE, _("%s: Unable to get argument data"), "getProcessMode");
return sciErr;
}
iMode = (int)pstMode[0][0];
FREE(pstMode[0]);
}
else
{
addErrorMessage(&sciErr, API_ERROR_GET_PROCESSMODE, _("%s: Wrong type for input argument #%d: A string or a scalar expected.\n"),
"getProcessMode", _iPos);
return sciErr;
}
if (iMode == ROW_LETTER || iMode == BY_ROWS)
{
*_piMode = BY_ROWS;
}
else if (iMode == COL_LETTER || iMode == BY_COLS)
{
*_piMode = BY_COLS;
}
else if (iMode == STAR_LETTER || iMode == BY_ALL)
{
*_piMode = BY_ALL;
}
else if (iMode == MTLB_LETTER || iMode == BY_MTLB)
{
*_piMode = 0;
if (iRows1 > 1)
{
*_piMode = 1;
}
else if (iCols1 > 1)
{
*_piMode = 2;
}
}
else
{
addErrorMessage(&sciErr, API_ERROR_GET_PROCESSMODE, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), "getProcessMode",
_iPos, "'*', 'r', 'c', 'm', '0', '1', '2'", "-1");
return sciErr;
}
return sciErr;
}
/*--------------------------------------------------------------------------*/
int sci_zneupd(char *fname, void *pvApiCtx)
{
SciErr sciErr;
int* piAddrpRVEC = NULL;
int* pRVEC = NULL;
int* piAddrpHOWMANY = NULL;
char* pHOWMANY = NULL;
int* piAddrpSELECT = NULL;
int* pSELECT = NULL;
int* piAddrpBMAT = NULL;
char* pBMAT = NULL;
int* piAddrpN = NULL;
int* pN = NULL;
int* piAddrpWHICH = NULL;
char* pWHICH = NULL;
int* piAddrpNEV = NULL;
int* pNEV = NULL;
int* piAddrpTOL = NULL;
double* pTOL = NULL;
int* piAddrpNCV = NULL;
int* pNCV = NULL;
int* piAddrpIPARAM = NULL;
int* pIPARAM = NULL;
int* piAddrpIPNTR = NULL;
int* pIPNTR = NULL;
int* piAddrpRWORK = NULL;
double* pRWORK = NULL;
int* piAddrpINFO = NULL;
int* pINFO = NULL;
int* piAddrpD = NULL;
doublecomplex* pD = NULL;
int* piAddrpZ = NULL;
doublecomplex* pZ = NULL;
int* piAddrpSIGMA = NULL;
doublecomplex* pSIGMA = NULL;
int* piAddrpWORKev = NULL;
doublecomplex* pWORKev = NULL;
int* piAddrpRESID = NULL;
doublecomplex* pRESID = NULL;
int* piAddrpWORKD = NULL;
doublecomplex* pV = NULL;
int* piAddrpV = NULL;
doublecomplex* pWORKD = NULL;
int* piAddrpWORKL = NULL;
doublecomplex* pWORKL = NULL;
int mRVEC, nRVEC;
int mSELECT, nSELECT;
int D, mD, nD;
int Z, mZ, nZ;
int mSIGMA, nSIGMA;
int mWORKev, nWORKev;
int mN, nN;
int mNEV, nNEV;
int mTOL, nTOL;
int RESID, mRESID, nRESID;
int mNCV, nNCV;
int mV, nV;
int IPARAM, mIPARAM, nIPARAM;
int IPNTR, mIPNTR, nIPNTR;
int WORKD, mWORKD, nWORKD;
int WORKL, mWORKL, nWORKL;
int RWORK, mRWORK, nRWORK;
int INFO, mINFO, nINFO;
int minlhs = 1, minrhs = 21, maxlhs = 9, maxrhs = 21;
int LDZ, LDV, LWORKL;
int sizeWORKL = 0;
CheckInputArgument(pvApiCtx, minrhs, maxrhs);
CheckOutputArgument(pvApiCtx, minlhs, maxlhs);
/* VARIABLE = NUMBER */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrpRVEC);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpRVEC, &mRVEC, &nRVEC, &pRVEC);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddrpSELECT);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 3.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpSELECT, &mSELECT, &nSELECT, &pSELECT);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 3);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddrpD);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 4.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpD, &mD, &nD, &pD);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 4);
return 1;
}
D = 4;
sciErr = getVarAddressFromPosition(pvApiCtx, 5, &piAddrpZ);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 5.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpZ, &mZ, &nZ, &pZ);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 5);
return 1;
}
Z = 5;
sciErr = getVarAddressFromPosition(pvApiCtx, 6, &piAddrpSIGMA);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 6.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpSIGMA, &mSIGMA, &nSIGMA, &pSIGMA);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 6);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 7, &piAddrpWORKev);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 7.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpWORKev, &mWORKev, &nWORKev, &pWORKev);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 7);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 9, &piAddrpN);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 9.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpN, &mN, &nN, &pN);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 9);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 11, &piAddrpNEV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 11.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpNEV, &mNEV, &nNEV, &pNEV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 11);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 12, &piAddrpTOL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 12.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrpTOL, &mTOL, &nTOL, &pTOL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 12);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 13, &piAddrpRESID);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 13.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpRESID, &mRESID, &nRESID, &pRESID);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 13);
return 1;
}
RESID = 13;
sciErr = getVarAddressFromPosition(pvApiCtx, 14, &piAddrpNCV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 14.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpNCV, &mNCV, &nNCV, &pNCV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 14);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 15, &piAddrpV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 15.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpV, &mV, &nV, &pV);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 15);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 16, &piAddrpIPARAM);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 16.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpIPARAM, &mIPARAM, &nIPARAM, &pIPARAM);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 16);
return 1;
}
IPARAM = 16;
sciErr = getVarAddressFromPosition(pvApiCtx, 17, &piAddrpIPNTR);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 17.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpIPNTR, &mIPNTR, &nIPNTR, &pIPNTR);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 17);
return 1;
}
IPNTR = 17;
sciErr = getVarAddressFromPosition(pvApiCtx, 18, &piAddrpWORKD);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 18.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpWORKD, &mWORKD, &nWORKD, &pWORKD);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 18);
return 1;
}
WORKD = 18;
sciErr = getVarAddressFromPosition(pvApiCtx, 19, &piAddrpWORKL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 19.
sciErr = getComplexZMatrixOfDouble(pvApiCtx, piAddrpWORKL, &mWORKL, &nWORKL, &pWORKL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 19);
return 1;
}
WORKL = 19;
sciErr = getVarAddressFromPosition(pvApiCtx, 20, &piAddrpRWORK);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 20.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrpRWORK, &mRWORK, &nRWORK, &pRWORK);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 20);
return 1;
}
RWORK = 20;
sciErr = getVarAddressFromPosition(pvApiCtx, 21, &piAddrpINFO);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 21.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpINFO, &mINFO, &nINFO, &pINFO);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 21);
return 1;
}
INFO = 21;
LWORKL = mWORKL * nWORKL;
LDV = Max(1, pN[0]);
LDZ = LDV;
/* Check some sizes */
if (mIPARAM * nIPARAM != 11)
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPARAM", 11);
return 1;
}
if (mIPNTR * nIPNTR != 14)
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPNTR", 14);
return 1;
}
if (mRESID * nRESID != pN[0])
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "RESID", pN[0]);
return 1;
}
if (mWORKD * nWORKD < 3 * pN[0])
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKD", 3 * pN[0]);
return 1;
}
if (mSELECT * nSELECT != pNCV[0])
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "SELECT", pNCV[0]);
return 1;
}
if (mD * nD != (pNEV[0] + 1))
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "D", pNEV[0] + 1);
return 1;
}
if ((mZ != pN[0]) || (nZ != pNEV[0]))
{
Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "Z", pN[0], pNEV[0]);
return 1;
}
if (mWORKev * nWORKev != 2 * pNCV[0])
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKev", 2 * pNCV[0]);
return 1;
}
if ((mV != pN[0]) || (nV != pNCV[0]))
{
Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", pN[0], pNCV[0]);
return 1;
}
sizeWORKL = 3 * pNCV[0] * pNCV[0] + 5 * pNCV[0];
if ((mWORKL * nWORKL < sizeWORKL))
{
Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrpHOWMANY);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
if (getAllocatedSingleString(pvApiCtx, piAddrpHOWMANY, &pHOWMANY))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 8, &piAddrpBMAT);
if (sciErr.iErr)
{
freeAllocatedSingleString(pHOWMANY);
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 8.
if (getAllocatedSingleString(pvApiCtx, piAddrpBMAT, &pBMAT))
{
freeAllocatedSingleString(pHOWMANY);
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 8);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 10, &piAddrpWHICH);
if (sciErr.iErr)
{
freeAllocatedSingleString(pHOWMANY);
freeAllocatedSingleString(pBMAT);
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 10.
if (getAllocatedSingleString(pvApiCtx, piAddrpWHICH, &pWHICH))
{
freeAllocatedSingleString(pHOWMANY);
freeAllocatedSingleString(pBMAT);
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 10);
return 1;
}
C2F(zneupd)(pRVEC, pHOWMANY, pSELECT, pD,
pZ, &LDZ, pSIGMA, pWORKev,
pBMAT, pN, pWHICH, pNEV,
pTOL, pRESID, pNCV, pV,
&LDV, pIPARAM, pIPNTR, pWORKD,
pWORKL, &LWORKL, pRWORK, pINFO);
freeAllocatedSingleString(pHOWMANY);
freeAllocatedSingleString(pBMAT);
freeAllocatedSingleString(pWHICH);
if (pINFO[0] < 0)
{
Scierror(998, _("%s: internal error, info=%d.\n"), fname, *pINFO);
return 0;
}
AssignOutputVariable(pvApiCtx, 1) = D;
AssignOutputVariable(pvApiCtx, 2) = Z;
AssignOutputVariable(pvApiCtx, 3) = RESID;
AssignOutputVariable(pvApiCtx, 4) = IPARAM;
AssignOutputVariable(pvApiCtx, 5) = IPNTR;
AssignOutputVariable(pvApiCtx, 6) = WORKD;
AssignOutputVariable(pvApiCtx, 7) = WORKL;
AssignOutputVariable(pvApiCtx, 8) = RWORK;
AssignOutputVariable(pvApiCtx, 9) = INFO;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_uimenu(char *fname, void *pvApiCtx)
{
SciErr sciErr;
int nbRow = 0, nbCol = 0;
int setStatus = SET_PROPERTY_SUCCEED;
int inputIndex = 0, beginIndex = 0;
char *propertyName = NULL;
int iParentUID = 0;
unsigned long GraphicHandle = 0;
int parentDefined = FALSE;
int iCurrentFigure = 0;
int iParentType = -1;
int *piParentType = &iParentType;
/* Create a new menu */
GraphicHandle = getHandle(CreateUimenu());
/* If no nbInputArgument(pvApiCtx) -> current figure is the parent (Ascendant compatibility) */
if (nbInputArgument(pvApiCtx) == 0)
{
// Set the parent property
iCurrentFigure = getCurrentFigure();
if (iCurrentFigure == 0)
{
iCurrentFigure = createNewFigureWithAxes();
}
setGraphicObjectRelationship(iCurrentFigure, getObjectFromHandle(GraphicHandle));
}
/**
* Odd number of input arguments
* First input is the parent ID
* All event inputs are property names
* All odd (except first) inputs are property values
*/
if (nbInputArgument(pvApiCtx) % 2 == 1)
{
if ((!checkInputArgumentType(pvApiCtx, 1, sci_handles)))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A graphic handle expected.\n"), fname, 1);
return FALSE;
}
else /* Get parent ID */
{
int *piAddr = NULL;
long long hParent = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of handle at position 1.
// YOU MUST REMOVE YOUR VARIABLE DECLARATION "int stkAdr".
if (getScalarHandle(pvApiCtx, piAddr, &hParent))
{
Scierror(202, _("%s: Wrong type for input argument #%d: Handle expected.\n"), fname, 1);
return 1;
}
iParentUID = getObjectFromHandle((long)hParent);
if (iParentUID != 0)
{
getGraphicObjectProperty(iParentUID, __GO_TYPE__, jni_int, (void **)&piParentType);
if (iParentType == __GO_FIGURE__ && iParentType == __GO_UIMENU__)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A '%s' or '%s' handle expected.\n"), fname, 1, "Figure", "Uimenu");
return FALSE;
}
// Set the parent property
callSetProperty(pvApiCtx, getObjectFromHandle(GraphicHandle), &hParent, sci_handles, 1, 1, "parent");
// Set the flag to avoid setting the parent two times
parentDefined = TRUE;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A '%s' or '%s' handle expected.\n"), fname, 1, "Figure", "Uimenu");
return FALSE;
}
// First input parameter which is a property name
beginIndex = 2;
}
}
/**
* Even number of input arguments
* All odd inputs are property names
* All even inputs are property values
*/
else
{
// First input parameter which is a property name
beginIndex = 1;
}
/* Read and set all properties */
for (inputIndex = beginIndex; inputIndex < nbInputArgument(pvApiCtx); inputIndex = inputIndex + 2)
{
int* piAddrValue = NULL;
int* piAddrProperty = NULL;
int isUserDataProperty = 0;
int iPropertyValuePositionIndex = inputIndex + 1;
size_t posStackOrAdr = 0;
/* Read property name */
if ((!checkInputArgumentType(pvApiCtx, inputIndex, sci_strings)))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname, inputIndex);
return FALSE;
}
else
{
sciErr = getVarAddressFromPosition(pvApiCtx, inputIndex, &piAddrProperty);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddrProperty, &propertyName))
{
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, inputIndex);
return 1;
}
if (stricmp(propertyName, "parent") == 0)
{
parentDefined = TRUE;
}
isUserDataProperty = (stricmp(propertyName, "user_data") == 0) || (stricmp(propertyName, "userdata") == 0);
}
sciErr = getVarAddressFromPosition(pvApiCtx, iPropertyValuePositionIndex, &piAddrValue);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isUserDataProperty)
{
nbRow = -1;
nbCol = -1;
setStatus = callSetProperty(pvApiCtx, getObjectFromHandle(GraphicHandle), piAddrValue, 0, 0, 0, propertyName);
}
else
{
/* Read property value */
switch (getInputArgumentType(pvApiCtx, iPropertyValuePositionIndex))
{
case sci_matrix:
{
double* pdblValue = NULL;
sciErr = getMatrixOfDouble(pvApiCtx, piAddrValue, &nbRow, &nbCol, &pdblValue);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, iPropertyValuePositionIndex);
return 1;
}
setStatus = callSetProperty(pvApiCtx, getObjectFromHandle(GraphicHandle), pdblValue, sci_matrix, nbRow, nbCol, propertyName);
break;
}
case sci_strings:
{
char* pstValue = NULL;
if (getAllocatedSingleString(pvApiCtx, piAddrValue, &pstValue))
{
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, iPropertyValuePositionIndex);
return 1;
}
nbRow = (int)strlen(pstValue);
nbCol = 1;
setStatus = callSetProperty(pvApiCtx, getObjectFromHandle(GraphicHandle), pstValue, sci_strings, nbRow, nbCol, propertyName);
freeAllocatedSingleString(pstValue);
break;
}
case sci_handles:
{
long long* phValues = NULL;
sciErr = getMatrixOfHandle(pvApiCtx, piAddrValue, &nbRow, &nbCol, &phValues);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for input argument #%d: Handle matrix expected.\n"), fname, iPropertyValuePositionIndex);
return 1;
}
setStatus = callSetProperty(pvApiCtx, getObjectFromHandle(GraphicHandle), phValues, sci_handles, nbRow, nbCol, propertyName);
break;
}
case sci_list:
{
getListItemNumber(pvApiCtx, piAddrValue, &nbRow);
nbCol = 1;
setStatus = callSetProperty(pvApiCtx, getObjectFromHandle(GraphicHandle), piAddrValue, sci_list, nbRow, nbCol, propertyName);
break;
}
default:
{
setStatus = SET_PROPERTY_ERROR;
break;
}
}
}
if (setStatus == SET_PROPERTY_ERROR)
{
Scierror(999, _("%s: Could not set property '%s'.\n"), fname, propertyName);
return FALSE;
}
freeAllocatedSingleString(propertyName);
}
/* If the parent is not given, the current figure is set as parent */
if (!parentDefined && (nbInputArgument(pvApiCtx) != 0))
{
// Set the parent property
iCurrentFigure = getCurrentFigure();
if (iCurrentFigure == 0)
{
iCurrentFigure = createNewFigureWithAxes();
}
setGraphicObjectRelationship(iCurrentFigure, getObjectFromHandle(GraphicHandle));
}
/* Create return variable */
nbRow = 1;
nbCol = 1;
// YOU MUST REMOVE YOUR VARIABLE DECLARATION "int stkAdr".
if (createScalarHandle(pvApiCtx, nbInputArgument(pvApiCtx) + 1, GraphicHandle))
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return TRUE;
}
int sci_gpuKronecker(char *fname)
{
CheckRhs(2, 2);
CheckLhs(1, 1);
SciErr sciErr;
int* piAddr_A = NULL;
int* piAddr_B = NULL;
GpuPointer* gpuPtrA = NULL;
GpuPointer* gpuPtrB = NULL;
GpuPointer* gpuPtrC = NULL;
double* h = NULL;
double* hi = NULL;
int rows = 0;
int cols = 0;
void* pvPtrA = NULL;
void* pvPtrB = NULL;
int inputType_A;
int inputType_B;
try
{
if (!isGpuInit())
{
throw "gpu is not initialised. Please launch gpuInit() before use this function.";
}
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr_A);
if (sciErr.iErr)
{
throw sciErr;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr_B);
if (sciErr.iErr)
{
throw sciErr;
}
/* ---- Check type of arguments and get data ---- */
/* */
/* Pointer to host / Pointer to device */
/* Matrix real / Matrix complex */
/* */
/* ---------------------------------------------- */
sciErr = getVarType(pvApiCtx, piAddr_A, &inputType_A);
if (sciErr.iErr)
{
throw sciErr;
}
sciErr = getVarType(pvApiCtx, piAddr_B, &inputType_B);
if (sciErr.iErr)
{
throw sciErr;
}
if (inputType_A == sci_pointer)
{
sciErr = getPointer(pvApiCtx, piAddr_A, (void**)&pvPtrA);
if (sciErr.iErr)
{
throw sciErr;
}
gpuPtrA = (GpuPointer*)pvPtrA;
if (!PointerManager::getInstance()->findGpuPointerInManager(gpuPtrA))
{
throw "gpuKronecker : Bad type for input argument #1: Variables created with GPU functions expected.";
}
if (useCuda() && gpuPtrA->getGpuType() != GpuPointer::CudaType)
{
throw "gpuKronecker : Bad type for input argument #1: A Cuda pointer expected.";
}
if (useCuda() == false && gpuPtrA->getGpuType() != GpuPointer::OpenCLType)
{
throw "gpuKronecker : Bad type for input argument #1: A OpenCL pointer expected.";
}
}
else if (inputType_A == sci_matrix)
{
if (isVarComplex(pvApiCtx, piAddr_A))
{
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddr_A, &rows, &cols, &h, &hi);
if (sciErr.iErr)
{
throw sciErr;
}
#ifdef WITH_CUDA
if (useCuda())
{
gpuPtrA = new PointerCuda(h, hi, rows, cols);
}
#endif
#ifdef WITH_OPENCL
if (!useCuda())
{
throw "gpuKronecker: not implemented with OpenCL.";
}
#endif
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddr_A, &rows, &cols, &h);
if (sciErr.iErr)
{
throw sciErr;
}
#ifdef WITH_CUDA
if (useCuda())
{
gpuPtrA = new PointerCuda(h, rows, cols);
}
#endif
#ifdef WITH_OPENCL
if (!useCuda())
{
throw "gpuKronecker: not implemented with OpenCL.";
}
#endif
}
}
else
{
throw "gpuKronecker : Bad type for input argument #1: A GPU or CPU matrix expected.";
}
if (inputType_B == sci_pointer)
{
sciErr = getPointer(pvApiCtx, piAddr_B, (void**)&pvPtrB);
if (sciErr.iErr)
{
throw sciErr;
}
gpuPtrB = (GpuPointer*)pvPtrB;
if (!PointerManager::getInstance()->findGpuPointerInManager(gpuPtrB))
{
throw "gpuKronecker : Bad type for input argument #2: Variables created with GPU functions expected.";
}
if (useCuda() && gpuPtrB->getGpuType() != GpuPointer::CudaType)
{
throw "gpuKronecker : Bad type for input argument #2: A Cuda pointer expected.";
}
if (useCuda() == false && gpuPtrB->getGpuType() != GpuPointer::OpenCLType)
{
throw "gpuKronecker : Bad type for input argument #2: A OpenCL pointer expected.";
}
}
else if (inputType_B == sci_matrix)
{
if (isVarComplex(pvApiCtx, piAddr_B))
{
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddr_B, &rows, &cols, &h, &hi);
if (sciErr.iErr)
{
throw sciErr;
}
#ifdef WITH_CUDA
if (useCuda())
{
gpuPtrB = new PointerCuda(h, hi, rows, cols);
}
#endif
#ifdef WITH_OPENCL
if (!useCuda())
{
Scierror(999, "gpuKronecker: not implemented with OpenCL.\n");
}
#endif
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddr_B, &rows, &cols, &h);
if (sciErr.iErr)
{
throw sciErr;
}
#ifdef WITH_CUDA
if (useCuda())
{
gpuPtrB = new PointerCuda(h, rows, cols);
}
#endif
#ifdef WITH_OPENCL
if (!useCuda())
{
Scierror(999, "gpuKronecker: not implemented with OpenCL.\n");
}
#endif
}
}
else
{
throw "gpuKronecker : Bad type for input argument #2: A GPU or CPU matrix expected.";
}
#ifdef WITH_OPENCL
if (!useCuda())
{
throw "gpuKronecker: not implemented with OpenCL.";
}
#endif
//performe operation.
gpuPtrC = gpuKronecker(gpuPtrA, gpuPtrB);
// Keep the result on the Device.
PointerManager::getInstance()->addGpuPointerInManager(gpuPtrC);
sciErr = createPointer(pvApiCtx, Rhs + 1, (void*)gpuPtrC);
if (sciErr.iErr)
{
throw sciErr;
}
LhsVar(1) = Rhs + 1;
if (inputType_A == sci_matrix && gpuPtrA != NULL)
{
delete gpuPtrA;
}
if (inputType_B == sci_matrix && gpuPtrB != NULL)
{
delete gpuPtrB;
}
PutLhsVar();
return 0;
}
catch (const char* str)
{
Scierror(999, "%s\n", str);
}
catch (SciErr E)
{
printError(&E, 0);
}
if (useCuda())
{
if (inputType_A == sci_matrix && gpuPtrA != NULL)
{
delete gpuPtrA;
}
if (inputType_B == sci_matrix && gpuPtrB != NULL)
{
delete gpuPtrB;
}
if (gpuPtrC != NULL)
{
delete gpuPtrC;
}
}
return EXIT_FAILURE;
}
/*--------------------------------------------------------------------------*/
int sci_qld(char *fname, unsigned long fname_len)
{
SciErr sciErr;
static int un = 1, zero = 0;
static int n = 0, nbis = 0;
static int unbis = 0;
static int mmax = 0, m = 0, mnn = 0;
static int mbis = 0;
static int pipo = 0;
static int ifail = 0;
int next = 0;
static int lwar = 0, iout = 0, k = 0, l = 0;
static double eps1 = 0;
int* piAddr1 = NULL;
int* piAddr2 = NULL;
int* piAddr3 = NULL;
int* piAddr4 = NULL;
int* piAddr5 = NULL;
int* piAddr6 = NULL;
int* piAddr7 = NULL;
double* Q = NULL;
double* p = NULL;
double* C = NULL;
double* b = NULL;
double* lb = NULL;
double* ub = NULL;
int* me = NULL;
double* x = NULL;
double* lambda = NULL;
int* inform = NULL;
double* war = NULL;
int* iwar = NULL;
/* Check rhs and lhs */
CheckInputArgument(pvApiCtx, 7, 8) ;
CheckOutputArgument(pvApiCtx, 1, 3) ;
/* RhsVar: qld(Q,p,C,b,lb,ub,me,eps) */
/* 1,2,3,4,5 ,6 ,7, 8 */
eps1 = C2F(dlamch)("e", 1L);
next = nbInputArgument(pvApiCtx) + 1;
/* Variable 1 (Q) */
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr1, &n, &nbis, &Q);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 1);
printError(&sciErr, 0);
return 1;
}
//CheckSquare
if (n != nbis)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A square matrix expected.\n"), fname, 1);
return 1;
}
/* Variable 2 (p) */
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr2, &nbis, &unbis, &p);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 2);
printError(&sciErr, 0);
return 1;
}
//CheckLength
if (nbis * unbis != n)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d expected.\n"), fname, 2, nbis * unbis);
return 1;
}
/* Variable 3 (C) */
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 3.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr3, &m, &nbis, &C);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
if (( nbis != n ) && (m > 0))
{
Scierror(205, _("%s: Wrong size for input argument #%d: number of columns %d expected.\n"), fname, 3, n);
return 0;
}
mmax = m;
mnn = m + n + n;
/* Variable 4 (b) */
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddr4);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 4.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr4, &mbis, &unbis, &b);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 4);
printError(&sciErr, 0);
return 1;
}
//CheckLength
if (mbis * unbis != m)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d expected.\n"), fname, 4, mbis * unbis);
return 1;
}
/* Variable 5 (lb) */
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 5, &piAddr5);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 5.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr5, &nbis, &unbis, &lb);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 5);
printError(&sciErr, 0);
return 1;
}
if (nbis*unbis == 0)
{
sciErr = allocMatrixOfDouble(pvApiCtx, next, n, un, &lb);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
for (k = 0; k < n; k++)
{
(lb)[k] = -C2F(dlamch)("o", 1L);
}
next = next + 1;
}
else if (nbis * unbis != n) //CheckLength
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d expected.\n"), fname, 5, nbis * unbis);
return 1;
}
/* Variable 6 (ub) */
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 6, &piAddr6);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 6.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr6, &nbis, &unbis, &ub);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 6);
printError(&sciErr, 0);
return 1;
}
if (nbis*unbis == 0)
{
sciErr = allocMatrixOfDouble(pvApiCtx, next, n, un, &ub);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
for (k = 0; k < n; k++)
{
(ub)[k] = C2F(dlamch)("o", 1L);
}
next = next + 1;
}
else if (nbis * unbis != n)//CheckLength
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d expected.\n"), fname, 6, nbis * unbis);
return 1;
}
/* Variable 7 (me) */
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 7, &piAddr7);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 7.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddr7, &pipo, &unbis, &me);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 7);
printError(&sciErr, 0);
return 1;
}
//CheckScalar
if (pipo != 1 || unbis != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, 7);
return 1;
}
if ((*(me) < 0) || (*(me) > n))
{
Err = 7;
SciError(116);
return 0;
}
if (nbInputArgument(pvApiCtx) == 8)
{
/* Variable 8 (eps1) */
//get variable address
int* piAddr8 = NULL;
double* leps = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 8, &piAddr8);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 8.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr8, &pipo, &unbis, &leps);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 8);
printError(&sciErr, 0);
return 1;
}
//CheckScalar
if (pipo != 1 || unbis != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, 8);
return 1;
}
eps1 = Max(eps1, *leps);
}
/* Internal variables: x, lambda, inform, C_mmax, b_mmax */
sciErr = allocMatrixOfDouble(pvApiCtx, next, n, un, &x);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
sciErr = allocMatrixOfDouble(pvApiCtx, next + 1, mnn, un, &lambda);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
sciErr = allocMatrixOfDoubleAsInteger(pvApiCtx, next + 2, un, un, &inform);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
lwar = 3 * n * n / 2 + 10 * n + 2 * mmax + 2;
sciErr = allocMatrixOfDouble(pvApiCtx, next + 3, lwar, un, &war);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
sciErr = allocMatrixOfDoubleAsInteger(pvApiCtx, next + 4, n, un, &iwar);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
(iwar)[0] = 1; /*Cholesky factorisation required*/
/* Change the sign of C*/
for (k = 0; k < n; k++)
{
for (l = 0; l < m; l++)
{
(C)[k * m + l] = -(C)[k * m + l];
}
}
iout = 0;
ifail = 0;
C2F(ql0001)(&m, (me), &mmax, &n, &n, &mnn, (Q), (p), (C),
(b), (lb), (ub), (x), (lambda), &iout,
&ifail, &zero, (war), &lwar, (iwar), &n, &eps1);
/* LhsVar: [x, lambda, inform] = qld(...) */
if (ifail == 0)
{
AssignOutputVariable(pvApiCtx, 1) = next;
AssignOutputVariable(pvApiCtx, 2) = next + 1;
if (nbOutputArgument(pvApiCtx) == 3)
{
AssignOutputVariable(pvApiCtx, 3) = next + 2;
*(inform) = ifail;
}
ReturnArguments(pvApiCtx);
}
else if (ifail == 1)
{
Scierror(24, _("%s: Too many iterations (more than %d).\n"), fname, 40 * (n + m));
}
else if (ifail == 2)
{
Scierror(24, _("%s: Accuracy insufficient to satisfy convergence criterion.\n"), fname);
}
else if (ifail == 5)
{
Scierror(999, _("%s: Length of working array is too short.\n"), fname);
}
else if (ifail > 10)
{
Scierror(999, _("%s: The constraints are inconsistent.\n"), fname);
}
else
{
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_bessely(char *fname, unsigned long fname_len)
{
int m1 = 0, n1 = 0, m2 = 0, n2 = 0;
int mr = 0, nr = 0, itr = 0, nw = 0;
int r1 = 0, r2 = 0, na = 0, nx = 0, kode = 0;
int isint = 0, ispos = 0, i = 0, t = 0;
int un = 1, nl2 = 0, ierr = 0;
int nbInputArg = 0;
double zero = 0.0;
double* pdblXR = NULL;
double* pdblXI = NULL;
double* pdbl1 = NULL;
int* piAddr1 = NULL;
int* piAddr3 = NULL;
int* piAddrX = NULL;
double* lwr = NULL;
double* lwi = NULL;
double* lr = NULL;
double* li = NULL;
SciErr sciErr;
CheckInputArgument(pvApiCtx, 2, 3);
nbInputArg = nbInputArgument(pvApiCtx);
kode = 1; /* ignored for real cases */
if (nbInputArg == 3)
{
/* normalized bessel required */
//get variable address of the input argument
double* l1;
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddr3, &m1, &n1, &l1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (m1*n1 != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, 3);
return 1;
}
kode = (int)l1[0] + 1;
}
/* get alpha */
//get variable address of the input argument
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddr1, &m1, &n1, &pdbl1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (m1*n1 == 0)
{
/*bessely([],x) */
AssignOutputVariable(pvApiCtx, 1) = 1;
ReturnArguments(pvApiCtx);
return 0;
}
/* get x */
//get variable address of the input argument
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrX);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddrX, &m2, &n2, &pdblXR, &pdblXI);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (m2*n2 == 0)
{
/*bessely(alpha,[]) */
AssignOutputVariable(pvApiCtx, 1) = 2;
ReturnArguments(pvApiCtx);
return 0;
}
/* determine if the result is real or complex */
if (pdblXI)
{
itr = 1;
}
else
{
ispos = 1;
for (i = 0; i < m2 * n2; i++)
{
if (pdblXR[i] < 0.0)
{
ispos = 0;
break;
}
}
if (ispos == 0)
{
itr = 1;
}
}
if (itr == 1 && pdblXI == NULL)
{
/* transform to complex */
double* l2r = NULL;
double* l2i = NULL;
int iSize = m2 * n2 * sizeof(double);
pdblXI = (double*)MALLOC(iSize);
memset(pdblXI, 0x00, iSize);
}
if (m1*n1 == 1)
{
/*bessely(scalar,matrix) */
double wr[2], wi[2];
double* lr = NULL;
double* li = NULL;
nx = m2 * n2;
na = 1;
if (itr == 0)
{
allocMatrixOfDouble(pvApiCtx, nbInputArg + 1, m2, n2, &lr);
C2F(dbesyv) (pdblXR, &nx, pdbl1, &na, &kode, lr, wr, &ierr);
}
else
{
allocComplexMatrixOfDouble(pvApiCtx, nbInputArg + 1, m2, n2, &lr, &li);
C2F(zbesyv) (pdblXR, pdblXI, &nx, pdbl1, &na, &kode, lr, li, wr, wi, &ierr);
}
}
else if (m2*n2 == 1)
{
/* bessely(matrix,scalar) */
nx = 1;
na = m1 * n1;
nw = 3 * na;
if (itr == 0)
{
allocMatrixOfDouble(pvApiCtx, nbInputArg + 1, m1, n1, &lr);
allocMatrixOfDouble(pvApiCtx, nbInputArg + 2, nx, nw, &lwr);
C2F(dbesyv) (pdblXR, &nx, pdbl1, &na, &kode, lr, lwr, &ierr);
}
else
{
allocComplexMatrixOfDouble(pvApiCtx, nbInputArg + 1, m1, n1, &lr, &li);
allocComplexMatrixOfDouble(pvApiCtx, nbInputArg + 2, nx, nw, &lwr, &lwi);
C2F(zbesyv) (pdblXR, pdblXI, &nx, pdbl1, &na, &kode, lr, li, lwr, lwi, &ierr);
}
}
else if ((m1 == 1 && n2 == 1) || (n1 == 1 && m2 == 1))
{
/* bessely(row,col) or bessely(col,row) */
mr = m2 * n2;
nr = m1 * n1;
nx = m2 * n2;
na = m1 * n1;
nw = 3 * na;
if (itr == 0)
{
allocMatrixOfDouble(pvApiCtx, nbInputArg + 1, mr, nr, &lr);
allocMatrixOfDouble(pvApiCtx, nbInputArg + 2, 1, nw, &lwr);
C2F(dbesyv) (pdblXR, &nx, pdbl1, &na, &kode, lr, lwr, &ierr);
}
else
{
allocComplexMatrixOfDouble(pvApiCtx, nbInputArg + 1, mr, nr, &lr, &li);
allocComplexMatrixOfDouble(pvApiCtx, nbInputArg + 2, 1, nw, &lwr, &lwi);
C2F(zbesyv) (pdblXR, pdblXI, &nx, pdbl1, &na, &kode, lr, li, lwr, lwi, &ierr);
}
}
else
{
/* element wise case */
double wr[2], wi[2];
if (m1 * n1 != m2 * n2)
{
Scierror(999, _("%s: arguments #%d and #%d have incompatible dimensions.\n"), fname, 1, 2);
if (itr == 1 && isVarComplex(pvApiCtx, piAddrX) == 0)
{
FREE(pdblXI);
}
return 1;
}
nx = m2 * n2;
na = -1;
if (itr == 0)
{
allocMatrixOfDouble(pvApiCtx, nbInputArg + 1, m2, n2, &lr);
C2F(dbesyv) (pdblXR, &nx, pdbl1, &na, &kode, lr, wr, &ierr);
}
else
{
allocComplexMatrixOfDouble(pvApiCtx, nbInputArg + 1, m2, n2, &lr, &li);
C2F(zbesyv) (pdblXR, pdblXI, &nx, pdbl1, &na, &kode, lr, li, wr, wi, &ierr);
}
}
if (itr == 1 && isVarComplex(pvApiCtx, piAddrX) == 0)
{
FREE(pdblXI);
}
if (ierr == 2)
{
if ( C2F(errgst).ieee == 0)
{
ierr = 69;
SciError(ierr);
}
else if ( C2F(errgst).ieee == 1)
{
ierr = 63;
C2F(msgs)(&ierr, &un);
}
}
else if (ierr == 3)
{
/* inacurate result */
ierr = 4;
C2F(msgs)(&ierr, &un);
}
else if (ierr == 4 || ierr == 5)
{
if ( C2F(errgst).ieee == 0)
{
ierr = 69;
SciError(ierr);
}
else if ( C2F(errgst).ieee == 1)
{
ierr = 107;
C2F(msgs)(&ierr, &un);
}
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArg + 1;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_exportUI(char * fname, unsigned long fname_len)
{
SciErr sciErr;
int* piAddrstackPointer = NULL;
int iFigureId = 0; // id of the figure to export
int *piFigureId = &iFigureId;
int iRows = 0;
int iCols = 0;
int iHandleType = -1;
int *piHandleType = &iHandleType;
CheckOutputArgument(pvApiCtx, 0, 1);
CheckInputArgument(pvApiCtx, 1, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrstackPointer);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (checkInputArgumentType(pvApiCtx, 1, sci_handles)) // exportUI(figHandle)
{
char *pstFigureUID = NULL;
char *pstHandleType = NULL;
long long* stackPointer = NULL;
// Retrieve a matrix of handle at position 1.
sciErr = getMatrixOfHandle(pvApiCtx, piAddrstackPointer, &iRows, &iCols, &stackPointer);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: Handle matrix expected.\n"), fname, 1);
return 1;
}
if (iRows * iCols != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A Real Scalar or a 'Figure' handle expected.\n"), fname, 1);
}
pstFigureUID = getObjectFromHandle((unsigned long) * stackPointer);
getGraphicObjectProperty(pstFigureUID, __GO_TYPE__, jni_int, (void **)&piHandleType);
if (iHandleType == __GO_FIGURE__)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A Real Scalar or a 'Figure' handle expected.\n"), fname, 1);
return FALSE;
}
getGraphicObjectProperty(pstFigureUID, __GO_ID__, jni_int, (void **)&piFigureId);
}
else if (checkInputArgumentType(pvApiCtx, 1, sci_matrix)) // exportUI(figId)
{
double* stackPointer = NULL;
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrstackPointer, &iRows, &iCols, &stackPointer);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 1);
return 1;
}
if (iRows * iCols != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A Real Scalar or a 'Figure' handle expected.\n"), fname, 1);
return FALSE;
}
iFigureId = (int) * stackPointer;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A Real Scalar or a 'Figure' handle expected.\n"), fname, 1);
return FALSE;
}
// call the export function
exportUserInterface(iFigureId);
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
int sci_gpuOnes(char *fname)
{
CheckLhs(1, 1);
void* pvPtr = NULL;
int* piAddr = NULL;
SciErr sciErr;
int inputType;
int iRows = 0;
int iCols = 0;
GpuPointer* gpOut = NULL;
try
{
if (!isGpuInit())
{
throw "gpu is not initialised. Please launch gpuInit() before use this function.";
}
if (Rhs == 1)
{
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
throw sciErr;
}
sciErr = getVarType(pvApiCtx, piAddr, &inputType);
if (inputType == sci_pointer)
{
sciErr = getPointer(pvApiCtx, piAddr, (void**)&pvPtr);
if (sciErr.iErr)
{
throw sciErr;
}
GpuPointer* gmat = (GpuPointer*)(pvPtr);
if (!PointerManager::getInstance()->findGpuPointerInManager(gmat))
{
throw "gpuOnes : Bad type for input argument #1. Only variables created with GPU functions allowed.";
}
if (useCuda() && gmat->getGpuType() != GpuPointer::CudaType)
{
throw "gpuOnes : Bad type for input argument #1: A Cuda pointer expected.";
}
if (useCuda() == false && gmat->getGpuType() != GpuPointer::OpenCLType)
{
throw "gpuOnes : Bad type for input argument #1: A OpenCL pointer expected.";
}
if (gmat->getDims() > 2)
{
throw "gpuOnes : Hypermatrix not yet implemented.";
}
iRows = gmat->getRows();
iCols = gmat->getCols();
}
else if (inputType == sci_matrix)
{
// Get size and data
double* h;
sciErr = getMatrixOfDouble(pvApiCtx, piAddr, &iRows, &iCols, &h);
}
else
{
throw "gpuOnes : Bad type for input argument #1 : A Matrix or GPU pointer expected.";
}
}
else
{
if (Rhs > 2)
{
throw "gpuOnes : Hypermatrix not yet implemented.";
}
int* piDimsArray = new int[Rhs];
for (int i = 0; i < Rhs; i++)
{
sciErr = getVarAddressFromPosition(pvApiCtx, i + 1, &piAddr);
if (sciErr.iErr)
{
throw sciErr;
}
sciErr = getVarType(pvApiCtx, piAddr, &inputType);
if (inputType != sci_matrix)
{
throw "gpuOnes : Bad type for input argument #%d : A Matrix expected.";
}
double* h;
sciErr = getMatrixOfDouble(pvApiCtx, piAddr, &iRows, &iCols, &h);
if (iRows * iCols != 1)
{
char str[100];
sprintf(str, "gpuOnes : Wrong size for input argument #%d : A scalar expected.", i + 1);
throw str;
}
piDimsArray[i] = (int)h[0];
}
iRows = piDimsArray[0];
iCols = piDimsArray[1];
delete piDimsArray;
}
#ifdef WITH_CUDA
if (useCuda())
{
gpOut = new PointerCuda(iRows, iCols, false);
gpOut->initMatrix(1);
}
#endif
#ifdef WITH_OPENCL
if (!useCuda())
{
Scierror(999, "gpuOnes: not implemented with OpenCL.\n");
}
#endif
PointerManager::getInstance()->addGpuPointerInManager(gpOut);
sciErr = createPointer(pvApiCtx, Rhs + 1, (void*)gpOut);
if (sciErr.iErr)
{
throw sciErr;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
#ifdef WITH_CUDA
catch (cudaError_t cudaE)
{
GpuError::treat_error<CUDAmode>((CUDAmode::Status)cudaE);
}
#endif
catch (const char* str)
{
Scierror(999, "%s\n", str);
}
catch (SciErr E)
{
printError(&E, 0);
}
return EXIT_FAILURE;
}
int sci_taucs_chsolve(char* fname, void* pvApiCtx)
{
SciErr sciErr;
int mb = 0, nb = 0;
int i = 0, j = 0, n = 0, it_flag = 0, Refinement = 0;
double norm_res = 0., norm_res_bis = 0.;
long double *wk = NULL;
int A_is_upper_triangular = 0;
taucs_handle_factors * pC = NULL;
SciSparse A;
int mA = 0; // rows
int nA = 0; // cols
int iNbItem = 0;
int* piNbItemRow = NULL;
int* piColPos = NULL;
double* pdblSpReal = NULL;
double* pdblSpImg = NULL;
int iComplex = 0;
int* piAddr1 = NULL;
int* piAddr2 = NULL;
int* piAddr3 = NULL;
void* pvPtr = NULL;
double* pdblB = NULL;
double* pdblX = NULL;
double* pdblV = NULL;
double* pdblRes = NULL;
/* Check numbers of input/output arguments */
CheckInputArgument(pvApiCtx, 2, 3);
CheckOutputArgument(pvApiCtx, 1, 1);
/* First get arg #1 : the pointer to the Cholesky factors */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getPointer(pvApiCtx, piAddr1, &pvPtr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
pC = (taucs_handle_factors *)pvPtr;
/* Check if this pointer is a valid ref to a Cholesky factor object */
if ( ! IsAdrInList( (Adr)pC, ListCholFactors, &it_flag) )
{
Scierror(999, _("%s: Wrong value for input argument #%d: not a valid reference to Cholesky factors"), fname, 1);
return 1;
}
/* the number of rows/lines of the matrix */
n = pC->n;
/* Get now arg #2 : the vector b */
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddr2, &mb, &nb, &pdblB);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* test if the right hand side is compatible */
if (mb != n || nb < 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, 2);
return 1;
}
if (Rhs == 3)
{
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isVarComplex(pvApiCtx, piAddr3))
{
Scierror(999, _("%s: Wrong type for input argument #%d: not compatible with the Cholesky factorization.\n"), fname, 3);
return 1;
}
sciErr = getSparseMatrix(pvApiCtx, piAddr3, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// fill struct sparse
A.m = mA;
A.n = nA;
A.it = iComplex;
A.nel = iNbItem;
A.mnel = piNbItemRow;
A.icol = piColPos;
A.R = pdblSpReal;
A.I = pdblSpImg;
if (mA != nA || mA != n)
{
Scierror(999, _("%s: Wrong size for input argument #%d: not compatible with the Cholesky factorization.\n"), fname, 3);
return 1;
}
Refinement = 1;
A_is_upper_triangular = is_sparse_upper_triangular(&A);
}
else
{
Refinement = 0;
}
/* allocate memory for the solution x */
sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, mb, nb, &pdblX);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (Refinement)
{
pdblRes = (double*)MALLOC(mb * sizeof(double));
if ( A_is_upper_triangular )
{
if ( (wk = (long double*)MALLOC( n * sizeof(long double))) == NULL )
{
if (pdblRes)
{
FREE(pdblRes);
}
Scierror(999, _("%s: not enough memory.\n"), fname);
return 1;
}
}
}
/* allocate memory for a temporary vector v */
pdblV = (double*)MALLOC(mb * sizeof(double));
for (j = 0; j < nb ; j++)
{
taucs_vec_permute(n, &pdblB[j * mb], &pdblX[j * mb], pC->p);
taucs_supernodal_solve_llt(pC->C, pdblV, &pdblX[j * mb]); /* FIXME : add a test here */
taucs_vec_ipermute(n, pdblV, &pdblX[j * mb], pC->p);
if (Refinement)
{
/* do one iterative refinement */
residu_with_prec_for_chol(&A, &pdblX[j * mb], &pdblV[j * mb], pdblRes, &norm_res, A_is_upper_triangular, wk);
/* FIXME: do a test if the norm_res has an anormal value and send a warning
* (the user has certainly not give the good matrix A
*/
taucs_vec_permute(n, pdblRes, pdblV, pC->p);
taucs_supernodal_solve_llt(pC->C, pdblRes, pdblV); /* FIXME : add a test here */
taucs_vec_ipermute(n, pdblRes, pdblV, pC->p);
for ( i = 0 ; i < n ; i++ )
{
pdblV[i] = pdblX[j * mb + i] - pdblV[i]; /* v is the refined solution */
}
residu_with_prec_for_chol(&A, pdblV, &pdblB[j * mb], pdblRes, &norm_res_bis, A_is_upper_triangular, wk);
/* accept it if the 2 norm of the residual is improved */
if ( norm_res_bis < norm_res )
{
for ( i = 0 ; i < n ; i++ )
{
pdblX[j * mb + i] = pdblV[i];
}
}
}
}
FREE(wk);
FREE(pdblV);
FREE(pdblRes);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_norm(char *fname, void* pvApiCtx)
{
SciErr sciErr;
// Arguments' addresses
int *pAAddr = NULL;
int *pflagAddr = NULL;
// Arguments' values
double *pA = NULL;
char *pflagChar = NULL;
doublecomplex *pAC = NULL;
double flagVal = 0;
// Arguments' properties (type, dimensions, length)
int iLen = 0;
int iType = 0;
int iRows = 0;
int iCols = 0;
// Return value
double ret = 0;
double RowsColsTemp = 0;
int i = 0;
int isMat = 0;
int isComplex = 0;
CheckInputArgument(pvApiCtx, 1, 2);
CheckOutputArgument(pvApiCtx, 1, 1);
// Checking A.
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &pAAddr); // Retrieving A address.
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
printError(&sciErr, 0);
return 0;
}
sciErr = getVarType(pvApiCtx, pAAddr, &iType); // Retrieving A type.
if (iType != sci_matrix)
{
OverLoad(1);
return 0;
}
if (isVarComplex(pvApiCtx, pAAddr))
{
sciErr = getComplexZMatrixOfDouble(pvApiCtx, pAAddr, &iRows, &iCols, &pAC);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: Real or complex matrix expected.\n"), fname, 1);
return 0;
}
isComplex = 1;
for (i = 0; i < iRows * iCols; ++i) // Checking A for %inf, which is not supported by Lapack.
{
if (la_isinf(pAC[i].r) != 0 || la_isinf(pAC[i].i) != 0 || ISNAN(pAC[i].r) || ISNAN(pAC[i].i))
{
Scierror(264, _("%s: Wrong value for argument #%d: Must not contain NaN or Inf.\n"), fname, 1);
return 0;
}
}
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, pAAddr, &iRows, &iCols, &pA);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: Real or complex matrix expected.\n"), fname, 1);
return 0;
}
for (i = 0 ; i < iRows * iCols ; i++) // Checking A for %inf, which is not supported by Lapack.
{
if (la_isinf(pA[i]) != 0 || ISNAN(pA[i]))
{
Scierror(264, _("%s: Wrong value for argument #%d: Must not contain NaN or Inf.\n"), fname, 1);
return 0;
}
}
}
if (iRows == 0) // A = [] => returning 0.
{
createScalarDouble(pvApiCtx, Rhs + 1, 0);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
if (iRows > 1 && iCols > 1) // If A is a matrix, only 1, 2 and %inf are allowed as second argument.
{
isMat = 1;
}
if (iRows == 1) // If iRows == 1, then transpose A to consider it like a vector.
{
RowsColsTemp = iRows;
iRows = iCols;
iCols = (int)RowsColsTemp;
}
if (Rhs == 1) // One argument => returning norm 2.
{
// Call normP() or normPC().
if (isComplex)
{
ret = normPC(pAC, iRows, iCols, 2); // if A is a complex matrix, call the complex function.
}
else
{
ret = normP(pA, iRows, iCols, 2);
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
// Checking flag.
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &pflagAddr); // Retrieving flag address.
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getVarType(pvApiCtx, pflagAddr, &iType); // Retrieving flag type.
if (iType != sci_strings && iType != sci_matrix)
{
Scierror(999, _("%s: Wrong type for input argument #%d: String or integer expected.\n"), fname, 2);
return 0;
}
if (iType == sci_strings)
{
if (getAllocatedSingleString(pvApiCtx, pflagAddr, &pflagChar)) // Retrieving flag dimensions.
{
Scierror(205, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 2);
return 0;
}
iLen = (int)strlen(pflagChar);
if (iLen != 3 && iLen != 1)
{
Scierror(116, _("%s: Wrong value for input argument #%d: %s, %s, %s, or %s expected.\n"), fname, 2, "i", "inf", "f", "fro");
freeAllocatedSingleString(pflagChar);
return 0;
}
if (strcmp(pflagChar, "inf") != 0 && strcmp(pflagChar, "i") != 0 &&
strcmp(pflagChar, "fro") != 0 && strcmp(pflagChar, "f") != 0) // flag must be = "inf", "i", "fro" or "f".
{
Scierror(116, _("%s: Wrong value for input argument #%d: %s, %s, %s or %s expected.\n"), fname, 2, "i", "inf", "f", "fro");
freeAllocatedSingleString(pflagChar);
return 0;
}
if (isComplex)
{
ret = normStringC(pAC, iRows, iCols, pflagChar); // if A is a complex matrix, call the complex function.
}
else
{
ret = normString(pA, iRows, iCols, pflagChar); // flag is a string => returning the corresponding norm.
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
freeAllocatedSingleString(pflagChar);
return 0;
}
else
{
if (isVarComplex(pvApiCtx, pflagAddr))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real expected.\n"), fname, 2);
return 0;
}
if (getScalarDouble(pvApiCtx, pflagAddr, &flagVal)) // Retrieving flag value & dimensions as a double.
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, 2);
return 0;
}
// Call the norm functions.
if (la_isinf(flagVal) == 1 && flagVal > 0) // flag = %inf
{
if (isComplex)
{
ret = normStringC(pAC, iRows, iCols, "inf"); // if A is a complex matrix, call the complex function.
}
else
{
ret = normString(pA, iRows, iCols, "inf"); // The infinite norm is computed by normString().
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
else
{
if (isMat == 1 && flagVal != 1 && flagVal != 2 && la_isinf(flagVal) == 0)
{
Scierror(116, _("%s: Wrong value for input argument #%d: %s, %s, %s or %s expected.\n"), fname, 2, "1", "2", "inf", "-inf");
return 0;
}
if (isComplex)
{
ret = normPC(pAC, iRows, iCols, flagVal); // if A is a complex matrix, call the complex function.
}
else
{
ret = normP(pA, iRows, iCols, flagVal); // flag is an integer => returning the corresponding norm.
}
createScalarDouble(pvApiCtx, Rhs + 1, ret);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_xgraduate(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int* piAddrl1 = NULL;
double* l1 = NULL;
int* piAddrl2 = NULL;
double* l2 = NULL;
double* lr = NULL;
double xa = 0., xi = 0.;
int m1 = 0, n1 = 0, m2 = 0, n2 = 0, i = 0;
int kMinr = 0, kMaxr = 0, ar = 0, np1 = 0, np2 = 0, un = 1;
CheckInputArgument(pvApiCtx, 2, 2);
CheckOutputArgument(pvApiCtx, 2, 7);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrl1, &m1, &n1, &l1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
return 1;
}
//CheckScalar
if (m1 != 1 || n1 != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, 1);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrl2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrl2, &m2, &n2, &l2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 2);
return 1;
}
//CheckScalar
if (m2 != 1 || n2 != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, 2);
return 1;
}
C2F(graduate)((l1), (l2), &xi, &xa, &np1, &np2, &kMinr, &kMaxr, &ar);
*l1 = xi;
*l2 = xa;
if (nbOutputArgument(pvApiCtx) >= 3)
{
sciErr = allocMatrixOfDouble(pvApiCtx, 3, un, un, &lr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
lr[0] = (double) np1;
}
if (nbOutputArgument(pvApiCtx) >= 4)
{
sciErr = allocMatrixOfDouble(pvApiCtx, 4, un, un, &lr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
lr[0] = (double) np2;
}
if (nbOutputArgument(pvApiCtx) >= 5)
{
sciErr = allocMatrixOfDouble(pvApiCtx, 5, un, un, &lr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
lr[0] = (double) kMinr;
}
if (nbOutputArgument(pvApiCtx) >= 6)
{
sciErr = allocMatrixOfDouble(pvApiCtx, 6, un, un, &lr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
lr[0] = (double) kMaxr;
}
if (nbOutputArgument(pvApiCtx) >= 7)
{
sciErr = allocMatrixOfDouble(pvApiCtx, 7, un, un, &lr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
lr[0] = (double) ar;
}
for (i = 1; i <= nbOutputArgument(pvApiCtx) ; i++)
{
AssignOutputVariable(pvApiCtx, i) = i;
}
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_fec(char *fname, void *pvApiCtx)
{
SciErr sciErr;
int m1 = 0, n1 = 0, m2 = 0, n2 = 0, m3 = 0, n3 = 0, m4 = 0, n4 = 0, mn1 = 0;
static rhs_opts opts[] =
{
{ -1, "colminmax", -1, 0, 0, NULL},
{ -1, "colout", -1, 0, 0, NULL},
{ -1, "leg", -1, 0, 0, NULL},
{ -1, "mesh", -1, 0, 0, NULL},
{ -1, "nax", -1, 0, 0, NULL},
{ -1, "rect", -1, 0, 0, NULL},
{ -1, "strf", -1, 0, 0, NULL},
{ -1, "zminmax", -1, 0, 0, NULL},
{ -1, NULL, -1, 0, 0, NULL}
};
char* strf = NULL;
char strfl[4];
char* legend = NULL;
double* rect = NULL;
double* zminmax = NULL;
int* colminmax = NULL;
int* nax = NULL;
int* colOut = NULL;
BOOL flagNax = FALSE;
BOOL withMesh = FALSE;
int* piAddr1 = NULL;
int* piAddr2 = NULL;
int* piAddr3 = NULL;
int* piAddr4 = NULL;
double* l1 = NULL;
double* l2 = NULL;
double* l3 = NULL;
double* l4 = NULL;
if (nbInputArgument(pvApiCtx) <= 0)
{
sci_demo(fname, pvApiCtx);
return 0;
}
CheckInputArgument(pvApiCtx, 4, 12);
if (getOptionals(pvApiCtx, fname, opts) == 0)
{
ReturnArguments(pvApiCtx);
return 0;
}
if (FirstOpt(pvApiCtx) < 5)
{
Scierror(999, _("%s: Misplaced optional argument: #%d must be at position %d.\n"), fname, 1, 5);
return -1;
}
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr1, &m1, &n1, &l1);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
printError(&sciErr, 0);
return 1;
}
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr2, &m2, &n2, &l2);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 2);
printError(&sciErr, 0);
return 1;
}
//CheckSameDims
if (m1 != m2 || n1 != n2)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d-by-%d matrix expected.\n"), fname, 1, m1, n1);
return 1;
}
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 3.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr3, &m3, &n3, &l3);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
if (n3 < 5)
{
Scierror(999, _("%s: Wrong number of columns for input argument #%d: at least %d expected.\n"), fname, 3, 5);
return 0;
}
// remove number and flag
n3 -= 2;
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddr4);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 4.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr4, &m4, &n4, &l4);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 4);
printError(&sciErr, 0);
return 1;
}
if (m1 * n1 == 0 || m3 == 0)
{
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
GetStrf(pvApiCtx, fname, 5, opts, &strf);
GetLegend(pvApiCtx, fname, 6, opts, &legend);
GetRect(pvApiCtx, fname, 7, opts, &rect);
GetNax(pvApiCtx, 8, opts, &nax, &flagNax);
GetZminmax(pvApiCtx, fname, 9, opts, &zminmax);
GetColminmax(pvApiCtx, fname, 10, opts, &colminmax);
GetColOut(pvApiCtx, fname, 11, opts, &colOut);
GetWithMesh(pvApiCtx, fname, 12, opts, &withMesh);
getOrCreateDefaultSubwin();
if (isDefStrf (strf))
{
strcpy(strfl, DEFSTRFN);
strf = strfl;
if (!isDefRect(rect))
{
strfl[1] = '7';
}
if (!isDefLegend(legend))
{
strfl[0] = '1';
}
}
mn1 = m1 * n1;
Objfec ((l1), (l2), (l3), (l4), &mn1, &m3, &n3, strf, legend, rect, nax, zminmax, colminmax, colOut, withMesh, flagNax);
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------
* sciset(choice-name,x1,x2,x3,x4,x5)
* or xset()
*-----------------------------------------------------------*/
int sci_set(char *fname, void *pvApiCtx)
{
SciErr sciErr;
int i = 0;
int* piAddr1 = NULL;
int isMatrixOfString = 0;
char* pstNewProperty = NULL;
unsigned long hdl;
int iObjUID = 0;
int iType = 0;
int* piType = &iType;
int iSetProperty = 0;
int iRhs = nbInputArgument(pvApiCtx);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
if (isMListType(pvApiCtx, piAddr1) || isTListType(pvApiCtx, piAddr1))
{
OverLoad(1);
return 0;
}
CheckInputArgumentAtLeast(pvApiCtx, 2);
CheckOutputArgument(pvApiCtx, 0, 1);
if (isDoubleType(pvApiCtx, piAddr1)) /* tclsci handle */
{
/* call "set" for tcl/tk see tclsci/sci_gateway/c/sci_set.c */
OverLoad(1);
return 0;
}
if (iRhs == 2)
{
#define NB_PROPERTIES_SUPPORTED 7
/* No object specified */
/* ONLY supported properties are */
/* 'current_entity' */
/* 'hdl' */
/* 'current_figure' */
/* 'current_axes' */
/* 'default_values' */
/* 'figure_style' for compatibility but do nothing */
/* others values must return a error */
char *propertiesSupported[NB_PROPERTIES_SUPPORTED] =
{
"current_entity",
"hdl",
"current_figure",
"current_axes",
"figure_style",
"default_values",
"auto_clear"
};
int iPropertyFound = 0;
int* piAddr2 = NULL;
int iType2 = 0;
int iRows2 = 0;
int iCols2 = 0;
void* pvData = NULL;
char* pstProperty = NULL;
if (isStringType(pvApiCtx, piAddr1) == 0)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, 1);
return 0;
}
if (getAllocatedSingleString(pvApiCtx, piAddr1, &pstProperty))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, 1);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddr2, &iType2);
if (sciErr.iErr)
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 1;
}
switch (iType2)
{
case sci_matrix:
sciErr = getMatrixOfDouble(pvApiCtx, piAddr2, &iRows2, &iCols2, (double**)&pvData);
if (sciErr.iErr)
{
freeAllocatedSingleString(pstProperty);
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: Matrix expected.\n"), fname, 2);
return sciErr.iErr;
}
break;
case sci_handles :
sciErr = getMatrixOfHandle(pvApiCtx, piAddr2, &iRows2, &iCols2, (long long**)&pvData);
if (sciErr.iErr)
{
freeAllocatedSingleString(pstProperty);
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: Matrix of handle expected.\n"), fname, 3);
return 1;
}
break;
case sci_strings :
if (strcmp(pstProperty, "tics_labels") == 0 || strcmp(pstProperty, "auto_ticks") == 0 ||
strcmp(pstProperty, "axes_visible") == 0 || strcmp(pstProperty, "axes_reverse") == 0 ||
strcmp(pstProperty, "text") == 0 || strcmp(pstProperty, "ticks_format") == 0)
{
isMatrixOfString = 1;
if (getAllocatedMatrixOfString(pvApiCtx, piAddr2, &iRows2, &iCols2, (char***)&pvData))
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Wrong size for input argument #%d: A matrix of string expected.\n"), fname, 2);
return 1;
}
}
else
{
if (getAllocatedSingleString(pvApiCtx, piAddr2, (char**)&pvData))
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, 2);
return 1;
}
iRows2 = (int)strlen((char*)pvData);
iCols2 = 1;
isMatrixOfString = 0;
}
break;
}
for (i = 0; i < NB_PROPERTIES_SUPPORTED; i++)
{
if (strcmp(propertiesSupported[i], pstProperty) == 0)
{
iPropertyFound = 1;
}
}
if (iPropertyFound)
{
callSetProperty(pvApiCtx, 0, pvData, iType2, iRows2, iCols2, pstProperty);
if (iType2 == sci_strings)
{
//free allocated data
if (isMatrixOfString == 1)
{
freeAllocatedMatrixOfString(iRows2, iCols2, (char**)pvData);
}
else
{
freeAllocatedSingleString((char*)pvData);
}
}
}
else
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Wrong value for input argument #%d: a valid property expected.\n"), fname, 1);
if (iType2 == sci_strings)
{
if (isMatrixOfString == 1)
{
freeAllocatedMatrixOfString(iRows2, iCols2, (char**)pvData);
}
else
{
freeAllocatedSingleString((char*)pvData);
}
}
return 0;
}
freeAllocatedSingleString(pstProperty);
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
if (iRhs % 2 != 1)
{
Scierror(999, _("%s: Wrong number of input argument(s) : an odd number is expected.\n"), fname);
return 0;
}
/* after the call to sciSet get the status : 0 <=> OK, */
/* -1 <=> Error, */
/* 1 <=> nothing done */
/* set or create a graphic window */
if (isHandleType(pvApiCtx, piAddr1) == 0 && isStringType(pvApiCtx, piAddr1) == 0)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A handle or a string expected.\n"), fname, 1);
return 0;
}
if (isStringType(pvApiCtx, piAddr1))
{
char* pstPath = NULL;
if (getAllocatedSingleString(pvApiCtx, piAddr1, &pstPath))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, 1);
return 1;
}
iObjUID = search_path(pstPath);
if (iObjUID == 0)
{
Scierror(999, _("%s: Unable to find handle for path %s.\n"), fname, pstPath);
freeAllocatedSingleString(pstPath);
return 1;
}
}
else
{
//matrix of handle are managed by a %h_set
if (isScalar(pvApiCtx, piAddr1) == FALSE)
{
OverLoad(1);
return 0;
}
if (getScalarHandle(pvApiCtx, piAddr1, (long long*)&hdl))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single handle expected.\n"), fname, 1);
return 1;
}
iObjUID = getObjectFromHandle(hdl);
}
if (iObjUID == 0)
{
Scierror(999, _("%s: The handle is not or no more valid.\n"), fname);
return 0;
}
for (i = 1 ; i < iRhs ; i = i + 2)
{
int setStatus = 0;
int* piAddr2 = NULL;
int* piAddr3 = NULL;
int iPos = i + 1;
int isData = 0;
int iRows3 = 0;
int iCols3 = 0;
int iType3 = 0;
void* pvData = NULL;
char* pstProperty = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, iPos, &piAddr2);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, iPos);
return 1;
}
if (isStringType(pvApiCtx, piAddr2) == 0)
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, iPos);
return 0;
}
if (getAllocatedSingleString(pvApiCtx, piAddr2, &pstProperty))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, iPos);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, iPos + 1, &piAddr3);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, iPos + 1);
return 1;
}
if ((pstProperty[0] == 'd' || pstProperty[0] == 'D') && stricmp("data", pstProperty) == 0)
{
//send to datamodel
isData = 1;
}
if (stricmp(pstProperty, "user_data") == 0 ||
stricmp(pstProperty, "userdata") == 0 ||
stricmp(pstProperty, "display_function_data") == 0 ||
stricmp(pstProperty, "data") == 0)
{
/* in this case set_user_data_property
* directly uses the third position in the stack
* to get the variable which is to be set in
* the user_data property (any data type is allowed) S. Steer */
pvData = (void*)piAddr3; /*position in the stack */
iRows3 = -1; /*unused */
iCols3 = -1; /*unused */
iType3 = -1;
}
else
{
sciErr = getVarType(pvApiCtx, piAddr3, &iType3);
if (sciErr.iErr)
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, iPos + 1);
return 1;
}
switch (iType3)
{
case sci_matrix :
sciErr = getMatrixOfDouble(pvApiCtx, piAddr3, &iRows3, &iCols3, (double**)&pvData);
break;
case sci_boolean :
sciErr = getMatrixOfBoolean(pvApiCtx, piAddr3, &iRows3, &iCols3, (int**)&pvData);
break;
case sci_handles :
sciErr = getMatrixOfHandle(pvApiCtx, piAddr3, &iRows3, &iCols3, (long long**)&pvData);
break;
case sci_strings :
if (strcmp(pstProperty, "tics_labels") != 0 && strcmp(pstProperty, "auto_ticks") != 0 && strcmp(pstProperty, "tight_limits") != 0 &&
strcmp(pstProperty, "axes_visible") != 0 && strcmp(pstProperty, "axes_reverse") != 0 &&
strcmp(pstProperty, "text") != 0 && stricmp(pstProperty, "string") != 0 &&
stricmp(pstProperty, "tooltipstring") != 0 && stricmp(pstProperty, "ticks_format") != 0) /* Added for uicontrols */
{
if (isScalar(pvApiCtx, piAddr3) == 0)
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, iPos + 1);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddr3, (char**)&pvData))
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, iPos + 1);
return 1;
}
iRows3 = (int)strlen((char*)pvData);
iCols3 = 1;
isMatrixOfString = 0;
}
else
{
isMatrixOfString = 1;
getAllocatedMatrixOfString(pvApiCtx, piAddr3, &iRows3, &iCols3, (char***)&pvData);
}
break;
case sci_list :
iCols3 = 1;
sciErr = getListItemNumber(pvApiCtx, piAddr3, &iRows3);
pvData = (void*)piAddr3; /* In this case l3 is the list position in stack */
break;
default :
pvData = (void*)piAddr3; /* In this case l3 is the list position in stack */
break;
}
if (sciErr.iErr)
{
freeAllocatedSingleString(pstProperty);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, iPos + 1);
return 1;
}
}
setStatus = callSetProperty(pvApiCtx, iObjUID, pvData, iType3, iRows3, iCols3, pstProperty);
if (iType3 == sci_strings)
{
//free allacted data
if (isMatrixOfString == 1)
{
freeAllocatedMatrixOfString(iRows3, iCols3, (char**)pvData);
}
else
{
freeAllocatedSingleString((char*)pvData);
}
}
freeAllocatedSingleString(pstProperty);
}
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_unsetmenu(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int* piAddrmenuNameAdr = NULL;
char* menuNameAdr = NULL;
int* piAddrfigureNumberAdr = NULL;
double* figureNumberAdr = NULL;
int* piAddrsubMenuIndexAdr = NULL;
double* subMenuIndexAdr = NULL;
int nbRow = 0;
int nbCol = 0;
// Check parameter number
CheckInputArgument(pvApiCtx, 1, 3);
CheckOutputArgument(pvApiCtx, 1, 1);
if (nbInputArgument(pvApiCtx) == 1)
{
// Error message in not in standard mode (we need figure number)
if (getScilabMode() != SCILAB_STD)
{
Scierror(999, _("%s: Figure number must be given when not in '%s' mode.\n"), fname, "STD");
return FALSE;
}
// Unset a Menu of Scilab Main Window
if ((!checkInputArgumentType(pvApiCtx, 1, sci_strings)))
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, 1);
return FALSE;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrmenuNameAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
if (getAllocatedSingleString(pvApiCtx, piAddrmenuNameAdr, &menuNameAdr))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 1);
return 1;
}
EnableMenu(getConsoleIdentifier(), menuNameAdr, FALSE);
freeAllocatedSingleString(menuNameAdr);
}
else if (nbInputArgument(pvApiCtx) == 2)
{
// Unset a Menu a Scilab Graphic Window
if ((checkInputArgumentType(pvApiCtx, 1, sci_matrix)) && (checkInputArgumentType(pvApiCtx, 2, sci_strings)))
{
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrfigureNumberAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrfigureNumberAdr, &nbRow, &nbCol, &figureNumberAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
return 1;
}
if (nbRow * nbCol != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real expected.\n"), fname, 1);
return FALSE;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrmenuNameAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
if (getAllocatedSingleString(pvApiCtx, piAddrmenuNameAdr, &menuNameAdr))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
return 1;
}
EnableMenu(getFigureFromIndex((int)*figureNumberAdr), menuNameAdr, FALSE);
freeAllocatedSingleString(menuNameAdr);
}
else if ((checkInputArgumentType(pvApiCtx, 1, sci_strings)) && (checkInputArgumentType(pvApiCtx, 2, sci_matrix))) // Unset a submenu in main window
{
// Error message in not in standard mode (we need figure number)
if (getScilabMode() != SCILAB_STD)
{
Scierror(999, _("%s: Figure number must be given when not in '%s' mode.\n"), fname, "STD");
return FALSE;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrmenuNameAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
if (getAllocatedSingleString(pvApiCtx, piAddrmenuNameAdr, &menuNameAdr))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 1);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrsubMenuIndexAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
freeAllocatedSingleString(menuNameAdr);
return 1;
}
// Retrieve a matrix of double at position 2.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrsubMenuIndexAdr, &nbRow, &nbCol, &subMenuIndexAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 2);
freeAllocatedSingleString(menuNameAdr);
return 1;
}
if (nbRow * nbCol != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real expected.\n"), fname, 2);
freeAllocatedSingleString(menuNameAdr);
return FALSE;
}
EnableSubMenu(getConsoleIdentifier(), menuNameAdr, (int)*subMenuIndexAdr, FALSE);
freeAllocatedSingleString(menuNameAdr);
}
else
{
Scierror(999, _("%s: Wrong input arguments: '%s' or '%s' expected.\n"), fname, "(button, nsub)", "(gwin, button)");
return FALSE;
}
}
else // Unset a submenu in graphics window
{
if ((checkInputArgumentType(pvApiCtx, 1, sci_matrix)))
{
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrfigureNumberAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrfigureNumberAdr, &nbRow, &nbCol, &figureNumberAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
return 1;
}
if (nbRow * nbCol != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real expected.\n"), fname, 1);
return FALSE;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real expected.\n"), fname, 1);
return FALSE;
}
if ((checkInputArgumentType(pvApiCtx, 2, sci_strings)))
{
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrmenuNameAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
if (getAllocatedSingleString(pvApiCtx, piAddrmenuNameAdr, &menuNameAdr))
{
Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
return 1;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, 2);
return FALSE;
}
if ((checkInputArgumentType(pvApiCtx, 3, sci_matrix)))
{
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddrsubMenuIndexAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
freeAllocatedSingleString(menuNameAdr);
return 1;
}
// Retrieve a matrix of double at position 3.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrsubMenuIndexAdr, &nbRow, &nbCol, &subMenuIndexAdr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 3);
freeAllocatedSingleString(menuNameAdr);
return 1;
}
if (nbRow * nbCol != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real expected.\n"), fname, 3);
freeAllocatedSingleString(menuNameAdr);
return FALSE;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real expected.\n"), fname, 3);
freeAllocatedSingleString(menuNameAdr);
return FALSE;
}
EnableSubMenu(getFigureFromIndex((int)*figureNumberAdr), menuNameAdr, (int)*subMenuIndexAdr, FALSE);
freeAllocatedSingleString(menuNameAdr);
}
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int xs2file(char * fname, ExportFileType fileType )
{
SciErr sciErr;
int* piAddrl1 = NULL;
int* piAddrfileName = NULL;
int* piAddrsciOrientation = NULL;
int* piAddrquality = NULL;
double* quality = NULL;
/* Check input and output sizes */
CheckOutputArgument(pvApiCtx, 0, 1);
if (isVectorialExport(fileType) || fileType == JPG_EXPORT)
{
CheckInputArgument(pvApiCtx, 2, 3);
}
else
{
CheckInputArgument(pvApiCtx, 2, 2);
}
if ((!checkInputArgumentType(pvApiCtx, 1, sci_matrix)) && (!checkInputArgumentType(pvApiCtx, 1, sci_handles)))
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer or a handle expected.\n"), fname, 1);
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 1;
}
if ( (checkInputArgumentType(pvApiCtx, 2, sci_strings)) )
{
char **fileName = NULL;
char *real_filename = NULL;
float jpegCompressionQuality = 0.95f;
ExportOrientation orientation = EXPORT_PORTRAIT; /* default orientation */
int m1 = 0, n1 = 0;
int figurenum = -1;
char* figureUID = NULL;
char *status = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* get handle by figure number */
if (checkInputArgumentType(pvApiCtx, 1, sci_matrix))
{
// Retrieve a matrix of double at position 1.
int* l1 = NULL;
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrl1, &m1, &n1, &l1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 1);
return 1;
}
if (m1 * n1 != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), fname, 1);
return 1;
}
figurenum = *l1;
if (!sciIsExistingFigure(figurenum))
{
Scierror(999, "%s: Input argument #%d must be a valid figure_id.\n", fname, 1);
return 1;
}
figureUID = (char*)getFigureFromIndex(figurenum);
}
/* check given handle */
else if (checkInputArgumentType(pvApiCtx, 1, sci_handles))
{
int iHandleType = -1;
int* piHandleType = &iHandleType;
long long* l1 = NULL;
// Retrieve a matrix of handle at position 1.
sciErr = getMatrixOfHandle(pvApiCtx, piAddrl1, &m1, &n1, &l1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: Handle matrix expected.\n"), fname, 1);
return 1;
}
if (m1 * n1 != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A graphic handle expected.\n"), fname, 1);
return 1;
}
figureUID = (char*)getObjectFromHandle((unsigned long) * l1);
if (figureUID == NULL)
{
Scierror(999, _("%s: Input argument #%d must be a valid handle.\n"), fname, 1);
return 1;
}
getGraphicObjectProperty(figureUID, __GO_TYPE__, jni_int, (void**)&piHandleType);
if (iHandleType != __GO_FIGURE__)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A ''%s'' handle expected.\n"), fname, 1, "Figure");
return 1;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar or figure handle expected.\n"), fname, 1);
return 1;
}
/* get file name */
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrfileName);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of string at position 2.
if (getAllocatedMatrixOfString(pvApiCtx, piAddrfileName, &m1, &n1, &fileName))
{
Scierror(202, _("%s: Wrong type for argument #%d: String matrix expected.\n"), fname, 2);
return 1;
}
if (m1 * n1 == 1)
{
if (nbInputArgument(pvApiCtx) == 3)
{
int nbCol = 0;
int nbRow = 0;
if (isVectorialExport(fileType))
{
char **sciOrientation = NULL;
if ((!checkInputArgumentType(pvApiCtx, 3, sci_strings)))
{
freeAllocatedMatrixOfString(m1, n1, fileName);
Scierror(999, _("%s: Wrong type for input argument #%d: Single character string expected.\n"), fname, 3);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddrsciOrientation);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of string at position 3.
if (getAllocatedMatrixOfString(pvApiCtx, piAddrsciOrientation, &nbRow, &nbCol, &sciOrientation))
{
freeAllocatedMatrixOfString(m1, n1, fileName);
Scierror(202, _("%s: Wrong type for argument #%d: String matrix expected.\n"), fname, 3);
return 1;
}
if (nbRow * nbCol == 1)
{
/* Value should be 'landscape' or 'portrait' but check only the first character */
/* for compatibility with Scilab 4*/
if (strcmp(sciOrientation[0], "landscape") == 0 || strcmp(sciOrientation[0], "l") == 0)
{
freeAllocatedMatrixOfString(nbRow, nbCol, sciOrientation);
orientation = EXPORT_LANDSCAPE;
}
else if (strcmp(sciOrientation[0], "portrait") == 0 || strcmp(sciOrientation[0], "p") == 0)
{
freeAllocatedMatrixOfString(nbRow, nbCol, sciOrientation);
orientation = EXPORT_PORTRAIT;
}
else
{
freeAllocatedMatrixOfString(m1, n1, fileName);
freeAllocatedMatrixOfString(nbRow, nbCol, sciOrientation);
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), fname, 3, "portrait", "landscape");
return 1;
}
}
else
{
freeAllocatedMatrixOfString(m1, n1, fileName);
freeAllocatedMatrixOfString(nbRow, nbCol, sciOrientation);
Scierror(999, _("%s: Wrong size for input argument #%d: Single character string expected.\n"), fname, 3);
return 1;
}
}
else
{
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddrquality);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 3.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrquality, &nbRow, &nbCol, &quality);
if (sciErr.iErr)
{
freeAllocatedMatrixOfString(m1, n1, fileName);
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 3);
return 1;
}
if (nbRow != 1 || nbCol != 1 || *quality < 0 || *quality > 1)
{
freeAllocatedMatrixOfString(m1, n1, fileName);
Scierror(999, _("%s: Wrong type for input argument #%d: A real between 0 and 1 expected.\n"), fname, 3);
return 1;
}
jpegCompressionQuality = (float) * quality;
}
}
/* Replaces SCI, ~, HOME, TMPDIR by the real path */
real_filename = expandPathVariable(fileName[0]);
/* Call the function for exporting file */
status = exportToFile(figureUID, real_filename, fileType, jpegCompressionQuality, orientation);
/* free pointers no more used */
if (real_filename)
{
FREE(real_filename);
real_filename = NULL;
}
freeAllocatedMatrixOfString(m1, n1, fileName);
/* treat errors */
if (strlen(status) != 0)
{
Scierror(999, _("%s: %s\n"), fname, status);
return 1;
}
}
else
{
freeAllocatedMatrixOfString(m1, n1, fileName);
Scierror(999, _("%s: Wrong size for input argument #%d: Single character string expected.\n"), fname, 2);
return 1;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: Single character string expected.\n"), fname, 2);
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
//function to remove specified columns
int sci_sym_delete_cols(char *fname, unsigned long fname_len){
// Error management variables
SciErr sciErr1,sciErr2;
double status=1.0;//assume error status
double num;//variable to store the number of columns to be deleted obtained from user in scilab
int count=0;//iterator variable
int num_cols;//stores the number of columns in the loaded problem
int iType= 0;//stores the datatype of matrix
int rows=0,columns=0;//integer variables to denote the number of rows and columns in the array denoting the column numbers to be deleted
unsigned int *value=NULL;//pointer to integer array allocated dynamically having the indices to be deleted
double *array_ptr=NULL;//double array pointer to the array denoting the column numbers to be deleted
int *piAddressVarOne = NULL;//pointer used to access first and second arguments of the function
int output=0;//output parameter for the symphony sym_delete_cols function
CheckInputArgument(pvApiCtx, 1, 1);//Check we have exactly one argument as input or not
CheckOutputArgument(pvApiCtx, 1, 1);//Check we have exactly one argument on output side or not
//load address of 1st argument into piAddressVarOne
sciErr2=getVarAddressFromPosition(pvApiCtx,1,&piAddressVarOne);
if (sciErr2.iErr){
printError(&sciErr2, 0);
return 0;
}
//check if it is double type
sciErr2 = getVarType(pvApiCtx, piAddressVarOne, &iType);
if(sciErr2.iErr || iType != sci_matrix)
{
printError(&sciErr2, 0);
return 0;
}
//getting the first argument as a double array
sciErr2=getMatrixOfDouble(pvApiCtx,piAddressVarOne,&rows,&columns,&array_ptr);
if (sciErr2.iErr){
printError(&sciErr2, 0);
return 0;
}
//dynamically allocate the integer array
value=(unsigned int *)malloc(sizeof(unsigned int)*columns);
//store double values in the integer array by typecasting
while(count<columns)
{
value[count]=(unsigned int)array_ptr[count];
count++;
}
sciprint("\n");
//ensure that environment is active
if(global_sym_env==NULL){
sciprint("Error: Symphony environment not initialized. Please run 'sym_open()' first.\n");
}
else {
int flag=0;//flag used for finding if the indices to be deleted are valid
output=sym_get_num_cols(global_sym_env,&num_cols);//function to find the number of columns in the loaded problem
if(output==FUNCTION_TERMINATED_ABNORMALLY)
{
Scierror(999, "An error occured. Has a problem been loaded?\n");
free(value);//freeing the memory of the allocated pointer
return 0;
}
for(count=0;count<columns;count++)//loop used to check if all the indices mentioned to be deleted are valid
{
if(value[count]<0 || value[count]>=num_cols){
flag=1;
break;
}
}
if(flag==1)
{
Scierror(999,"Not valid indices..\n");
sciprint("valid indices are from 0 to %d",num_cols-1);
free(value);//freeing the memory of the allocated pointer
return 0;
}
//only when the number of columns to be deleted is lesser than the actual number of columns ,execution is proceeded with
if(columns<=num_cols){
output=sym_delete_cols(global_sym_env,(unsigned int)columns,value);//symphony function to delete the columns specified
if(output==FUNCTION_TERMINATED_NORMALLY)
{
sciprint("Execution is successfull\n");
status=0.0;
}
else if(output==FUNCTION_TERMINATED_ABNORMALLY)
{
Scierror(999,"Problem occured while deleting the columns,Are the column numbers correct?\n");
sciprint("Function terminated abnormally\n");
status=1.0;
}
}
else{
sciprint("These many number of variables dont exist in the problem\n");
status=1.0;
}
}
int e=createScalarDouble(pvApiCtx,nbInputArgument(pvApiCtx)+1,status);
if (e){
AssignOutputVariable(pvApiCtx, 1) = 0;
free(value);//freeing the memory of the allocated pointer
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
free(value);//freeing the memory of the allocated pointer
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_fftw_flags(char *fname, void* pvApiCtx)
{
/* declaration of variables to store scilab parameters address */
static int m1 = 0, n1 = 0;
char **Str1 = NULL;
char **Str3 = NULL;
unsigned int uiVar1 = 0;
int* piDataOut = NULL;
int* piAddr1 = NULL;
int* piLen = NULL;
int iType = 0;
/* please update me ! */
static int nb_flag = 22;
static char *Str[] =
{
/* documented flags */
"FFTW_MEASURE",
"FFTW_DESTROY_INPUT",
"FFTW_UNALIGNED",
"FFTW_CONSERVE_MEMORY",
"FFTW_EXHAUSTIVE",
"FFTW_PRESERVE_INPUT",
"FFTW_PATIENT",
"FFTW_ESTIMATE",
/* undocumented beyond-guru flags */
"FFTW_ESTIMATE_PATIENT",
"FFTW_BELIEVE_PCOST",
"FFTW_NO_DFT_R2HC",
"FFTW_NO_NONTHREADED",
"FFTW_NO_BUFFERING",
"FFTW_NO_INDIRECT_OP",
"FFTW_ALLOW_LARGE_GENERIC",
"FFTW_NO_RANK_SPLITS",
"FFTW_NO_VRANK_SPLITS",
"FFTW_NO_VRECURSE",
"FFTW_NO_SIMD",
"FFTW_NO_SLOW",
"FFTW_NO_FIXED_RADIX_LARGE_N",
"FFTW_ALLOW_PRUNING"
};
static unsigned flagt[] =
{
/* documented flags */
FFTW_MEASURE,
FFTW_DESTROY_INPUT,
FFTW_UNALIGNED,
FFTW_CONSERVE_MEMORY,
FFTW_EXHAUSTIVE,
FFTW_PRESERVE_INPUT,
FFTW_PATIENT,
FFTW_ESTIMATE,
/* undocumented beyond-guru flags */
FFTW_ESTIMATE_PATIENT,
FFTW_BELIEVE_PCOST,
FFTW_NO_DFT_R2HC,
FFTW_NO_NONTHREADED,
FFTW_NO_BUFFERING,
FFTW_NO_INDIRECT_OP,
FFTW_ALLOW_LARGE_GENERIC,
FFTW_NO_RANK_SPLITS,
FFTW_NO_VRANK_SPLITS,
FFTW_NO_VRECURSE,
FFTW_NO_SIMD,
FFTW_NO_SLOW,
FFTW_NO_FIXED_RADIX_LARGE_N,
FFTW_ALLOW_PRUNING
};
unsigned flagv = 0;
int i = 0, j = 0;
SciErr sciErr;
CheckInputArgument(pvApiCtx, 0, 1);
if (nbInputArgument(pvApiCtx) == 0)
{
// nothing
}
else
{
//get variable address of the input argument
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
getVarType(pvApiCtx, piAddr1, &iType);
switch (iType)
{
case sci_ints:
{
/* int */
int iPrecision = 0;
int* pi32Data = NULL;
unsigned int* pui32Data = NULL;
getMatrixOfIntegerPrecision(pvApiCtx, piAddr1, &iPrecision);
if (iPrecision != SCI_INT32 && iPrecision != SCI_UINT32)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A int32 expected.\n"), fname, 1);
return 1;
}
if (iPrecision == SCI_INT32)
{
sciErr = getMatrixOfInteger32(pvApiCtx, piAddr1, &m1, &n1, &pi32Data);
uiVar1 = (unsigned int)pi32Data[0];
}
else
{
sciErr = getMatrixOfUnsignedInteger32(pvApiCtx, piAddr1, &m1, &n1, &pui32Data);
uiVar1 = pui32Data[0];
}
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
printError(&sciErr, 0);
return 1;
}
break;
}
case sci_matrix:
{
/* double */
double* pdblData = NULL;
sciErr = getMatrixOfDouble(pvApiCtx, piAddr1, &m1, &n1, &pdblData);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
printError(&sciErr, 0);
return 1;
}
uiVar1 = (unsigned int)pdblData[0];
break;
}
case sci_strings:
{
/* string */
//fisrt call to retrieve dimensions
sciErr = getMatrixOfString(pvApiCtx, piAddr1, &m1, &n1, NULL, NULL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
piLen = (int*)MALLOC(sizeof(int) * m1 * n1);
//second call to retrieve length of each string
sciErr = getMatrixOfString(pvApiCtx, piAddr1, &m1, &n1, piLen, NULL);
if (sciErr.iErr)
{
free(piLen);
printError(&sciErr, 0);
return 1;
}
Str1 = (char**)MALLOC(sizeof(char*) * m1 * n1);
for (i = 0 ; i < m1 * n1 ; i++)
{
Str1[i] = (char*)MALLOC(sizeof(char) * (piLen[i] + 1));//+ 1 for null termination
}
//third call to retrieve data
sciErr = getMatrixOfString(pvApiCtx, piAddr1, &m1, &n1, piLen, Str1);
if (sciErr.iErr)
{
free(piLen);
freeArrayOfString(Str1, m1 * n1);
printError(&sciErr, 0);
return 1;
}
for (j = 0; j < m1 * n1; j++)
{
for (i = 0; i < nb_flag; i++)
{
if (strcmp(Str1[j], Str[i]) == 0)
{
break;
}
}
if (i == nb_flag)
{
free(piLen);
freeArrayOfString(Str1, m1 * n1);
Scierror(999, _("%s: Wrong values for input argument #%d: FFTW flag expected.\n"), fname, 1);
return 0;
}
else
{
if (i > 0)
{
flagv = ( flagv | (1U << (i - 1)) );
}
}
}
uiVar1 = (unsigned int)flagv;
free(piLen);
freeArrayOfString(Str1, m1 * n1);
m1 = 1;
n1 = 1;
break;
}
default:
Scierror(53, _("%s: Wrong type for input argument #%d.\n"), fname, 1);
return 1;
}
if (m1 != 1 || n1 != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d-by-%d matrix expected.\n"), fname, 1, 1, 1);
return 1;
}
setCurrentFftwFlags(uiVar1);
}
/* return value of Sci_Plan.flags in position 2 */
sciErr = allocMatrixOfInteger32(pvApiCtx, nbInputArgument(pvApiCtx) + 2, 1, 1, &piDataOut);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: No more memory.\n"), fname);
return 1;
}
piDataOut[0] = (int) getCurrentFftwFlags();
/*Test for only FFTW_MEASURE*/
if (getCurrentFftwFlags() == 0)
{
j = 1;
if ((Str3 = (char **)MALLOC(sizeof(char *))) == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 1;
}
Str3[0] = os_strdup(Str[0]);
if (Str3[0] == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
FREE(Str3);
return 1;
}
}
else
{
j = 0;
for (i = 1; i < nb_flag; i++)
{
if ((getCurrentFftwFlags() & flagt[i]) == flagt[i])
{
j++;
if (Str3)
{
Str3 = (char **)REALLOC(Str3, sizeof(char *) * j);
}
else
{
Str3 = (char **)MALLOC(sizeof(char *) * j);
}
if (Str3 == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 1;
}
Str3[j - 1] = os_strdup(Str[i]);
if (Str3[j - 1] == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
freeArrayOfString(Str3, j);
return 1;
}
}
}
}
if (Str3 == NULL)
{
Scierror(999, _("%s: Failed to generate the planner name.\n"), fname);
return 1;
}
/* Create the string matrix as return of the function */
sciErr = createMatrixOfString(pvApiCtx, nbInputArgument(pvApiCtx) + 3, j, 1, Str3);
freeArrayOfString(Str3, j); // Data have been copied into Scilab memory
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 2;
AssignOutputVariable(pvApiCtx, 2) = nbInputArgument(pvApiCtx) + 3;
ReturnArguments(pvApiCtx);
return 0;
}
/* ==================================================================== */
int sci_fsum(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int m1 = 0, n1 = 0;
int *piAddressVarOne = NULL;
double *pdVarOne = NULL;
int iType1 = 0;
int m2 = 0, n2 = 0;
int *piAddressVarTwo = NULL;
double *pdVarTwo = NULL;
int iType2 = 0;
int m_out = 0, n_out = 0;
double dOut = 0.0;
/* --> result = csum(3,8)
/* check that we have only 2 parameters input */
/* check that we have only 1 parameters output */
CheckInputArgument(pvApiCtx, 2, 2) ;
CheckOutputArgument(pvApiCtx, 1, 1) ;
/* get Address of inputs */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
/* check input type */
sciErr = getVarType(pvApiCtx, piAddressVarOne, &iType1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if ( iType1 != sci_matrix )
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), fname, 1);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarTwo, &iType2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if ( iType2 != sci_matrix )
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), fname, 2);
return 0;
}
/* get matrix */
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &m1, &n1, &pdVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo, &m2, &n2, &pdVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
/* check size */
if ( (m1 != n1) && (n1 != 1) )
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), fname, 1);
return 0;
}
if ( (m2 != n2) && (n2 != 1) )
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), fname, 2);
return 0;
}
/* call fortran subroutine fsum */
F2C(fsum)(&pdVarOne[0], &pdVarTwo[0], &dOut);
/* create result on stack */
m_out = 1;
n_out = 1;
sciErr = createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, m_out, n_out, &dOut);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_frexp(char *fname, void *pvApiCtx)
{
SciErr sciErr;
int i;
int iRows = 0;
int iCols = 0;
int iType = 0;
int *piAddr = NULL;
double *pdblReal = NULL;
double *pdblCoef = NULL;
double *pdblExp = NULL;
CheckRhs(1, 1);
CheckLhs(2, 2);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddr, &iType);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if (iType != sci_matrix)
{
OverLoad(1);
return 0;
}
if (isVarComplex(pvApiCtx, piAddr))
{
Scierror(999, _("%s: Wrong type for input argument #%d: Real matrix expected.\n"), fname, 1);
return 0;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddr, &iRows, &iCols, &pdblReal);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = allocMatrixOfDouble(pvApiCtx, Rhs + 1, iRows, iCols, &pdblCoef);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = allocMatrixOfDouble(pvApiCtx, Rhs + 2, iRows, iCols, &pdblExp);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
for (i = 0; i < iRows * iCols; i++)
{
pdblCoef[i] = dfrexps(pdblReal[i], &pdblExp[i]);
}
LhsVar(1) = Rhs + 1;
LhsVar(2) = Rhs + 2;
PutLhsVar();
return 0;
}
/* ========================================================================== */
int sci_gpuLU(char *fname)
{
CheckRhs(1,2);
CheckLhs(2,2);
#ifdef WITH_CUDA
cublasStatus status;
#endif
SciErr sciErr;
int* piAddr_A = NULL;
double* h_A = NULL;
double* hi_A = NULL;
int rows_A;
int cols_A;
int* piAddr_Opt = NULL;
double* option = NULL;
int rows_Opt;
int cols_Opt;
void* d_A = NULL;
int na;
void* pvPtr = NULL;
int size_A = sizeof(double);
bool bComplex_A = FALSE;
int inputType_A;
int inputType_Opt;
double res;
int posOutput = 1;
try
{
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr_A);
if(sciErr.iErr) throw sciErr;
if(Rhs == 2)
{
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr_Opt);
if(sciErr.iErr) throw sciErr;
sciErr = getVarType(pvApiCtx, piAddr_Opt, &inputType_Opt);
if(sciErr.iErr) throw sciErr;
if(inputType_Opt == sci_matrix)
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddr_Opt, &rows_Opt, &cols_Opt, &option);
if(sciErr.iErr) throw sciErr;
}
else
throw "Option syntax is [number,number].";
}
else
{
rows_Opt=1;
cols_Opt=2;
option = (double*)malloc(2*sizeof(double));
option[0]=0;
option[1]=0;
}
if(rows_Opt != 1 || cols_Opt != 2)
throw "Option syntax is [number,number].";
if((int)option[1] == 1 && !isGpuInit())
throw "gpu is not initialised. Please launch gpuInit() before use this function.";
sciErr = getVarType(pvApiCtx, piAddr_A, &inputType_A);
if(sciErr.iErr) throw sciErr;
#ifdef WITH_CUDA
if (useCuda())
{
if(inputType_A == sci_pointer)
{
sciErr = getPointer(pvApiCtx, piAddr_A, (void**)&pvPtr);
if(sciErr.iErr) throw sciErr;
gpuMat_CUDA* gmat;
gmat = static_cast<gpuMat_CUDA*>(pvPtr);
if(!gmat->useCuda)
throw "Please switch to OpenCL mode before use this data.";
rows_A=gmat->rows;
cols_A=gmat->columns;
if(gmat->complex)
{
bComplex_A = TRUE;
size_A = sizeof(cuDoubleComplex);
d_A=(cuDoubleComplex*)gmat->ptr->get_ptr();
}
else
d_A=(double*)gmat->ptr->get_ptr();
// Initialize CUBLAS
status = cublasInit();
if (status != CUBLAS_STATUS_SUCCESS) throw status;
na = rows_A * cols_A;
}
else if(inputType_A == 1)
{
// Get size and data
if(isVarComplex(pvApiCtx, piAddr_A))
{
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddr_A, &rows_A, &cols_A, &h_A, &hi_A);
if(sciErr.iErr) throw sciErr;
size_A = sizeof(cuDoubleComplex);
bComplex_A = TRUE;
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddr_A, &rows_A, &cols_A, &h_A);
if(sciErr.iErr) throw sciErr;
}
na = rows_A * cols_A;
// Initialize CUBLAS
status = cublasInit();
if (status != CUBLAS_STATUS_SUCCESS) throw status;
// Allocate device memory
status = cublasAlloc(na, size_A, (void**)&d_A);
if (status != CUBLAS_STATUS_SUCCESS) throw status;
// Initialize the device matrices with the host matrices
if(!bComplex_A)
{
status = cublasSetMatrix(rows_A,cols_A, sizeof(double), h_A, rows_A, (double*)d_A, rows_A);
if (status != CUBLAS_STATUS_SUCCESS) throw status;
}
else
writecucomplex(h_A, hi_A, rows_A, cols_A, (cuDoubleComplex *)d_A);
}
else
throw "Bad argument type.";
cuDoubleComplex resComplex;
// Performs operation
if(!bComplex_A)
status = decomposeBlockedLU(rows_A, cols_A, rows_A, (double*)d_A, 1);
// else
// resComplex = cublasZtrsm(na,(cuDoubleComplex*)d_A);
if (status != CUBLAS_STATUS_SUCCESS) throw status;
// Put the result in scilab
switch((int)option[0])
{
case 2 :
case 1 : sciprint("The first option must be 0 for this function. Considered as 0.\n");
case 0 : // Keep the result on the Host.
{ // Put the result in scilab
if(!bComplex_A)
{
double* h_res = NULL;
sciErr=allocMatrixOfDouble(pvApiCtx, Rhs + posOutput, rows_A, cols_A, &h_res);
if(sciErr.iErr) throw sciErr;
status = cublasGetMatrix(rows_A,cols_A, sizeof(double), (double*)d_A, rows_A, h_res, rows_A);
if (status != CUBLAS_STATUS_SUCCESS) throw status;
}
else
{
sciErr = createComplexMatrixOfDouble(pvApiCtx, Rhs + posOutput, 1, 1, &resComplex.x,&resComplex.y);
if(sciErr.iErr) throw sciErr;
}
LhsVar(posOutput)=Rhs+posOutput;
posOutput++;
break;
}
default : throw "First option argument must be 0 or 1 or 2.";
}
switch((int)option[1])
{
case 0 : // Don't keep the data input on Device.
{
if(inputType_A == sci_matrix)
{
status = cublasFree(d_A);
if (status != CUBLAS_STATUS_SUCCESS) throw status;
d_A = NULL;
}
break;
}
case 1 : // Keep data of the fisrt argument on Device and return the Device pointer.
{
if(inputType_A == sci_matrix)
{
gpuMat_CUDA* dptr;
gpuMat_CUDA tmp={getCudaContext()->genMatrix<double>(getCudaQueue(),rows_A*cols_A),rows_A,cols_A};
dptr=new gpuMat_CUDA(tmp);
dptr->useCuda = true;
dptr->ptr->set_ptr((double*)d_A);
if(bComplex_A)
dptr->complex=TRUE;
else
dptr->complex=FALSE;
sciErr = createPointer(pvApiCtx,Rhs+posOutput, (void*)dptr);
if(sciErr.iErr) throw sciErr;
LhsVar(posOutput)=Rhs+posOutput;
}
else
throw "The first input argument is already a GPU variable.";
posOutput++;
break;
}
default : throw "Second option argument must be 0 or 1.";
}
// Shutdown
status = cublasShutdown();
if (status != CUBLAS_STATUS_SUCCESS) throw status;
}
#endif
#ifdef WITH_OPENCL
if (!useCuda())
{
throw "not implemented with OpenCL.";
}
#endif
if(Rhs == 1)
{
free(option);
option = NULL;
}
if(posOutput < Lhs+1)
throw "Too many output arguments.";
if(posOutput > Lhs+1)
throw "Too few output arguments.";
PutLhsVar();
return 0;
}
catch(const char* str)
{
Scierror(999,"%s\n",str);
}
catch(SciErr E)
{
printError(&E, 0);
}
#ifdef WITH_CUDA
catch(cudaError_t cudaE)
{
GpuError::treat_error<CUDAmode>((CUDAmode::Status)cudaE);
}
catch(cublasStatus CublasE)
{
GpuError::treat_error<CUDAmode>((CUDAmode::Status)CublasE,1);
}
if (useCuda())
{
if(inputType_A == 1 && d_A != NULL) cudaFree(d_A);
}
#endif
#ifdef WITH_OPENCL
if (!useCuda())
{
Scierror(999,"not implemented with OpenCL.\n");
}
#endif
if(Rhs == 1 && option != NULL) free(option);
return EXIT_FAILURE;
}
/*--------------------------------------------------------------------------*/
int get_rect_arg(void* _pvCtx, char *fname, int pos, rhs_opts opts[], double ** rect)
{
int m, n, first_opt = FirstOpt(), kopt, i;
if (pos < first_opt)
{
int* piAddr = 0;
int iType = 0;
double* pdblData = NULL;
getVarAddressFromPosition(_pvCtx, pos, &piAddr);
getVarType(_pvCtx, piAddr, &iType);
if (iType)
{
getMatrixOfDouble(_pvCtx, piAddr, &m, &n, &pdblData);
if (m * n != 4)
{
Scierror(999, "%s: Wrong size for input argument #%d: %d expected\n", fname, pos, 4);
return 0;
}
*rect = pdblData;
for (i = 0; i < 4; i++)
{
if (finite((*rect)[i]) == 0)
{
Scierror(999, "%s: Wrong values (Nan or Inf) for input argument: %d finite values expected\n", fname, 4);
return 0;
}
}
}
else
{
/** global value can be modified **/
double zeros[4] = { 0.0, 0.0, 0.0, 0.0 };
setDefRect(zeros);
*rect = getDefRect();
}
}
else if ((kopt = FindOpt("rect", opts))) /* named argument: rect=value */
{
int* piAddr = 0;
double* pdblData = NULL;
getVarAddressFromPosition(_pvCtx, kopt, &piAddr);
getMatrixOfDouble(_pvCtx, piAddr, &m, &n, &pdblData);
if (m * n != 4)
{
Scierror(999, "%s: Wrong size for input argument #%d: %d expected\n", fname, kopt, 4);
return 0;
}
*rect = pdblData;
for (i = 0; i < 4; i++)
{
if (finite((*rect)[i]) == 0)
{
Scierror(999, "%s: Wrong values (Nan or Inf) for input argument: %d finite values expected\n", fname, 4);
return 0;
}
}
}
else
{
/** global value can be modified **/
double zeros[4] = { 0.0, 0.0, 0.0, 0.0 };
setDefRect(zeros);
*rect = getDefRect();
}
return 1;
}
/*--------------------------------------------------------------------------*/
int sci_xget(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int* piAddrl1 = NULL;
char* l1 = NULL;
int* piAddrl2 = NULL;
double* l2 = NULL;
char* l3 = NULL;
int m1 = 0, m2 = 0, n2 = 0, i = 0;
int one = 1;
BOOL keyFound = FALSE;
if (nbInputArgument(pvApiCtx) <= 0)
{
sci_demo(fname, fname_len);
return 0;
}
CheckInputArgument(pvApiCtx, 1, 2);
CheckOutputArgument(pvApiCtx, 0, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
if (getAllocatedSingleString(pvApiCtx, piAddrl1, &l1))
{
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 1);
return 1;
}
/* check if key is valid */
for (i = 0; i < NUMSETFONC ; i++)
{
if (strcmp((l1), KeyTab_[i]) == 0)
{
keyFound = TRUE;
break;
}
}
if (!keyFound)
{
Scierror(999, _("%s: Unrecognized input argument: '%s'.\n"), fname, (l1));
freeAllocatedSingleString(l1);
return -1;
}
if (nbInputArgument(pvApiCtx) == 2)
{
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrl2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
freeAllocatedSingleString(l1);
return 1;
}
// Retrieve a matrix of double at position 2.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrl2, &m2, &n2, &l2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 2);
freeAllocatedSingleString(l1);
return 1;
}
//CheckScalar
if (m2 != 1 || n2 != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), fname, 2);
freeAllocatedSingleString(l1);
return 1;
}
}
if (strcmp(l1, "fpf") == 0 || strcmp(l1, "auto clear") == 0)
{
int bufl;
char buf[4096];
/* special case for global variables set */
xgetg((l1), buf, &bufl, m1, bsiz);
if (allocSingleString(pvApiCtx, nbInputArgument(pvApiCtx) + 1, bufl * one, (const char **)&l3))
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
freeAllocatedSingleString(l1);
return 1;
}
strncpy((l3), buf, bufl);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "colormap") == 0)
{
int iObjUID = 0;
// Force figure creation if none exists.
getOrCreateDefaultSubwin();
iObjUID = getCurrentFigure();
get_color_map_property(pvApiCtx, iObjUID);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "mark") == 0)
{
int iObjUID = getOrCreateDefaultSubwin();
int iMarkStyle = 0;
int* piMarkStyle = &iMarkStyle;
int iMarkSize = 0;
int* piMarkSize = &iMarkSize;
double pdblResult[2];
getGraphicObjectProperty(iObjUID, __GO_MARK_STYLE__, jni_int, (void**)&piMarkStyle);
getGraphicObjectProperty(iObjUID, __GO_MARK_SIZE__, jni_int, (void**)&piMarkSize);
pdblResult[0] = iMarkStyle;
pdblResult[1] = iMarkSize;
createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, 1, 2, pdblResult);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "mark size") == 0)
{
int iObjUID = getOrCreateDefaultSubwin();
get_mark_size_property(pvApiCtx, iObjUID);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "line style") == 0)
{
get_line_style_property(pvApiCtx, getOrCreateDefaultSubwin());
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "clipping") == 0)
{
double *clipBox = NULL;
int iObjUID = getOrCreateDefaultSubwin();
getGraphicObjectProperty(iObjUID, __GO_CLIP_BOX__, jni_double_vector, (void **)&clipBox);
createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, 1, 4, clipBox);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "font") == 0)
{
int iObjUID = getOrCreateDefaultSubwin();
double dblFontSize = 0;
double* pdblFontSize = &dblFontSize;
int iFontStyle = 0;
int* piFontStyle = &iFontStyle;
double pdblResult[2];
getGraphicObjectProperty(iObjUID, __GO_FONT_SIZE__, jni_double, (void **)&pdblFontSize);
getGraphicObjectProperty(iObjUID, __GO_FONT_STYLE__, jni_int, (void**)&piFontStyle);
pdblResult[0] = iFontStyle;
pdblResult[1] = dblFontSize;
createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, 1, 2, pdblResult);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "font size") == 0)
{
double dblFontSize = 0;
double* pdblFontSize = &dblFontSize;
getGraphicObjectProperty(getOrCreateDefaultSubwin(), __GO_FONT_SIZE__, jni_double, (void **)&pdblFontSize);
createScalarDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, dblFontSize);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "dashes") == 0)
{
int iLineStyle = 0;
int* piLineStyle = &iLineStyle;
getGraphicObjectProperty(getOrCreateDefaultSubwin(), __GO_LINE_STYLE__, jni_int, (void**)&piLineStyle);
createScalarDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iLineStyle);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "hidden3d") == 0)
{
get_hidden_color_property(pvApiCtx, getOrCreateDefaultSubwin());
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "window") == 0 || strcmp(l1, "figure") == 0)
{
int iFigureId = 0;
int* piFigureId = &iFigureId;
getOrCreateDefaultSubwin();
getGraphicObjectProperty(getCurrentFigure(), __GO_ID__, jni_int, (void**)&piFigureId);
createScalarDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iFigureId);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "thickness") == 0)
{
get_thickness_property(pvApiCtx, getOrCreateDefaultSubwin());
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "wdim") == 0 || strcmp(l1, "wpdim") == 0)
{
int *piFigureSize = NULL;
double pdblFigureSize[2];
getOrCreateDefaultSubwin();
getGraphicObjectProperty(getCurrentFigure(), __GO_SIZE__, jni_int_vector, (void **) &piFigureSize);
pdblFigureSize[0] = (double) piFigureSize[0];
pdblFigureSize[1] = (double) piFigureSize[1];
createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, 1, 2, pdblFigureSize);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "wpos") == 0)
{
int *piFigurePosition = NULL;
double pdblFigurePosition[2];
getOrCreateDefaultSubwin();
getGraphicObjectProperty(getCurrentFigure(), __GO_POSITION__, jni_int_vector, (void **) &piFigurePosition);
pdblFigurePosition[0] = piFigurePosition[0];
pdblFigurePosition[1] = piFigurePosition[1];
createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, 1, 2, pdblFigurePosition);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "viewport") == 0)
{
int* viewport = NULL;
double pdblViewport[2];
getOrCreateDefaultSubwin();
getGraphicObjectProperty(getCurrentFigure(), __GO_VIEWPORT__, jni_int_vector, (void **)&viewport);
pdblViewport[0] = viewport[0];
pdblViewport[1] = viewport[1];
createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, 1, 2, pdblViewport);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "background") == 0)
{
get_background_property(pvApiCtx, getOrCreateDefaultSubwin());
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if ( strcmp(l1, "color") == 0
|| strcmp(l1, "foreground") == 0
|| strcmp(l1, "pattern") == 0)
{
get_foreground_property(pvApiCtx, getOrCreateDefaultSubwin());
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "lastpattern") == 0)
{
int iNumColors = 0;
int* piNumColors = &iNumColors;
getOrCreateDefaultSubwin();
getGraphicObjectProperty(getCurrentFigure(), __GO_COLORMAP_SIZE__, jni_int, (void**)&piNumColors);
createScalarDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iNumColors);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "line mode") == 0)
{
int iLineMode = 0;
int* lineMode = &iLineMode;
getGraphicObjectProperty(getOrCreateDefaultSubwin(), __GO_LINE_MODE__, jni_bool, (void **)&lineMode);
createScalarDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iLineMode);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "white") == 0)
{
int iNumColors = 0;
int* piNumColors = &iNumColors;
getOrCreateDefaultSubwin();
getGraphicObjectProperty(getCurrentFigure(), __GO_COLORMAP_SIZE__, jni_int, (void**)&piNumColors);
/* White is lqst colormap index + 2 */
createScalarDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iNumColors + 2);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "wresize") == 0)
{
// autoresize property
int iAutoResize = 0;
int* piAutoResize = &iAutoResize;
getOrCreateDefaultSubwin();
getGraphicObjectProperty(getCurrentFigure(), __GO_AUTORESIZE__, jni_bool, (void **)&piAutoResize);
createScalarDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iAutoResize);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "clipgrf") == 0)
{
/* clip_state : 0 = off, 1 = on */
int iClipState = 0;
int* piClipState = &iClipState;
getGraphicObjectProperty(getOrCreateDefaultSubwin(), __GO_CLIP_STATE__, jni_int, (void**)&piClipState);
createScalarDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, iClipState);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else if (strcmp(l1, "clipoff") == 0)
{
int iClipState = 0;
int* piClipState = &iClipState;
getGraphicObjectProperty(getOrCreateDefaultSubwin(), __GO_CLIP_STATE__, jni_int, (void**)&piClipState);
/* clip_state : 0 = off, 1 = on */
if (iClipState == 0)
{
createScalarDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, 1);
}
else
{
createScalarDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, 0);
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
}
else
{
Scierror(999, _("%s: Unrecognized input argument: '%s'.\n"), fname, (l1));
freeAllocatedSingleString(l1);
return -1;
}
freeAllocatedSingleString(l1);
return 0;
}
/*------------------------------------------------------------------------*/
int sci_param3d(char * fname, void *pvApiCtx)
{
SciErr sciErr;
int izcol = 0, isfac = 0;
static double ebox_def[6] = { 0, 1, 0, 1, 0, 1};
double *ebox = ebox_def;
static int iflag_def[3] = {1, 2, 4};
int iflag[3], *ifl = NULL, ix1 = 0, one = 1;
double alpha_def = 35.0 , theta_def = 45.0;
double *alpha = &alpha_def, *theta = &theta_def;
int m1 = 0, n1 = 0, m2 = 0, n2 = 0, m3 = 0, n3 = 0;
int m3n = 0, n3n = 0; /* F.Leray 19.03.04*/
static rhs_opts opts[] =
{
{ -1, "alpha", -1, 0, 0, NULL},
{ -1, "ebox", -1, 0, 0, NULL},
{ -1, "flag", -1, 0, 0, NULL},
{ -1, "leg", -1, 0, 0, NULL},
{ -1, "theta", -1, 0, 0, NULL},
{ -1, NULL, -1, 0, 0, NULL}
};
char * labels = NULL;
int* piAddr1 = NULL;
int* piAddr2 = NULL;
int* piAddr3 = NULL;
double* l1 = NULL;
double* l2 = NULL;
double* l3 = NULL;
if (nbInputArgument(pvApiCtx) <= 0)
{
sci_demo(fname, pvApiCtx);
return 0;
}
CheckInputArgument(pvApiCtx, 3, 8);
if (getOptionals(pvApiCtx, fname, opts) == 0)
{
ReturnArguments(pvApiCtx);
return 0;
}
if (FirstOpt(pvApiCtx) < 4)
{
Scierror(999, _("%s: Misplaced optional argument: #%d must be at position %d.\n"), fname, 1, 4);
return(0);
}
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr1, &m1, &n1, &l1);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
printError(&sciErr, 0);
return 1;
}
if (m1 * n1 == 0)
{
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr2, &m2, &n2, &l2);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 2);
printError(&sciErr, 0);
return 1;
}
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 3.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr3, &m3, &n3, &l3);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
//CheckSameDims
if (m1 != m2 || n1 != n2)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d-by-%d matrix expected.\n"), fname, 1, m1, n1);
return 1;
}
//CheckSameDims
if (m2 != m3 || n2 != n3)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d-by-%d matrix expected.\n"), fname, 2, m2, n2);
return 1;
}
GetOptionalDoubleArg(pvApiCtx, fname, 4, "theta", &theta, 1, opts);
GetOptionalDoubleArg(pvApiCtx, fname, 5, "alpha", &alpha, 1, opts);
GetLabels(pvApiCtx, fname, 6, opts, &labels);
iflag_def[1] = 8;
ifl = &(iflag_def[1]);
GetOptionalIntArg(pvApiCtx, fname, 7, "flag", &ifl, 2, opts);
iflag[0] = iflag_def[0];
iflag[1] = ifl[0];
iflag[2] = ifl[1];
GetOptionalDoubleArg(pvApiCtx, fname, 8, "ebox", &ebox, 6, opts);
getOrCreateDefaultSubwin();
ix1 = m1 * n1;
/* NG beg */
isfac = -1;
izcol = 0;
Objplot3d (fname, &isfac, &izcol, (l1), (l2), (l3), (double *) NULL, &ix1, &one, theta, alpha, labels, iflag, ebox, &m1, &n1, &m2, &n2, &m3, &n3, &m3n, &n3n); /*Adding F.Leray 12.03.04 */
/* NG end */
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_xfarcs(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int* piAddrl1 = NULL;
double* l1 = NULL;
int* piAddr2 = NULL;
int* l2 = NULL;
int m1 = 0, n1 = 0;
int m2 = 0, n2 = 0;
long hdl = 0;
int i = 0;
double angle1 = 0.0;
double angle2 = 0.0;
CheckInputArgument(pvApiCtx, 1, 2);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDouble(pvApiCtx, piAddrl1, &m1, &n1, &l1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 1);
return 1;
}
if (m1 != 6)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %s expected.\n"), fname, 1, "(6,n)");
return 0;
}
if (nbInputArgument(pvApiCtx) == 2)
{
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddr2, &m2, &n2, &l2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 2);
return 1;
}
//CheckVector
if (m2 != 1 && n2 != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: Vector expected.\n"), fname, 2);
return 1;
}
if (n1 != m2 * n2)
{
Scierror(999, _("%s: Wrong size for input arguments #%d and #%d.\n"), fname, 1, 2);
return 0;
}
}
else
{
m2 = 1;
n2 = n1;
sciErr = allocMatrixOfDoubleAsInteger(pvApiCtx, 2, m2, n2, &l2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
for (i = 0; i < n2; ++i)
{
*((int*)(l2 + i)) = i + 1;
}
}
getOrCreateDefaultSubwin();
for (i = 0; i < n1; ++i)
{
angle1 = DEG2RAD(*(l1 + (6 * i) + 4) / 64.0);
angle2 = DEG2RAD(*(l1 + (6 * i) + 5) / 64.0);
Objarc(&angle1, &angle2, (l1 + (6 * i)), (l1 + (6 * i) + 1),
(l1 + (6 * i) + 2), (l1 + (6 * i) + 3), (int*)(l2 + i), (int*)(l2 + i), TRUE, FALSE, &hdl);
}
/** Construct Compound and make it current object **/
{
char * o = ConstructCompoundSeq(n1);
setCurrentObject(o);
releaseGraphicObjectProperty(__GO_PARENT__, o, jni_string, 1);
}
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_plot3d(char * fname, unsigned long fname_len)
{
SciErr sciErr;
static double ebox_def [6] = { 0, 1, 0, 1, 0, 1};
double *ebox = ebox_def;
static int iflag_def[3] = {2, 2, 4};
int *iflag = iflag_def;
double alpha_def = 35.0 , theta_def = 45.0;
double *alpha = &alpha_def, *theta = &theta_def;
int m1 = 0, n1 = 0, m2 = 0, n2 = 0, m3 = 0, n3 = 0;
int m3n = 0, n3n = 0, m3l = 0;
int izcol = 0, isfac = 0;
double *zcol = NULL;
static rhs_opts opts[] =
{
{ -1, "alpha", -1, 0, 0, NULL},
{ -1, "ebox", -1, 0, 0, NULL},
{ -1, "flag", -1, 0, 0, NULL},
{ -1, "leg", -1, 0, 0, NULL},
{ -1, "theta", -1, 0, 0, NULL},
{ -1, NULL, -1, 0, 0, NULL}
};
char * legend = NULL;
int* piAddr1 = NULL;
int* piAddr2 = NULL;
int* piAddr3 = NULL;
int* piAddr31 = NULL;
int* piAddr32 = NULL;
double* l1 = NULL;
double* l2 = NULL;
double* l3 = NULL;
double* l3n = NULL;
/*
** This overload the function to call demo script
** the demo script is called %_<fname>
*/
if (nbInputArgument(pvApiCtx) <= 0)
{
sci_demo(fname, fname_len);
return 0;
}
CheckInputArgument(pvApiCtx, 3, 8);
if (getOptionals(pvApiCtx, fname, opts) == 0)
{
ReturnArguments(pvApiCtx);
return 0;
}
if (FirstOpt() < 4)
{
Scierror(999, _("%s: Misplaced optional argument: #%d must be at position %d.\n"), fname, 1, 4);
return -1;
}
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr1, &m1, &n1, &l1);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 1);
printError(&sciErr, 0);
return 1;
}
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 2.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr2, &m2, &n2, &l2);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 2);
printError(&sciErr, 0);
return 1;
}
if (m1 * n1 == 0)
{
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
if (nbInputArgument(pvApiCtx) >= 3)
{
/* third argument can be a matrix z or a list list(z,zcol) */
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
switch (getInputArgumentType(pvApiCtx, 3))
{
case sci_matrix :
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 3.
sciErr = getMatrixOfDouble(pvApiCtx, piAddr3, &m3, &n3, &l3);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
izcol = 0;
break;
case sci_list :
izcol = 1;
/* z = list(z,colors) */
sciErr = getListItemNumber(pvApiCtx, piAddr3, &m3l);
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
if (m3l != 2)
{
Scierror(999, _("%s: Wrong size for input argument #%d: List of size %d expected.\n"),
fname, 2, m3l, 2);
return 1;
}
sciErr = getListItemAddress(pvApiCtx, piAddr3, 1, &piAddr31);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddr31, &m3, &n3, &l3); /* z */
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
sciErr = getListItemAddress(pvApiCtx, piAddr3, 2, &piAddr32);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddr32, &m3n, &n3n, &l3n); /* z */
if (sciErr.iErr)
{
Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 3);
printError(&sciErr, 0);
return 1;
}
zcol = (l3n);
if (m3n * n3n != n3 && m3n * n3n != m3 * n3)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %d or %d expected.\n"), fname, 3, n3, m3 * n3);
return 1;
}
/*
* Added by E Segre 4/5/2000. In the case where zcol is a
* matrix of the same size as z, we set izcol to 2. This
* value is later transmitted to the C2F(fac3dg) routine,
* which has been modified to do the interpolated shading
* (see the file SCI/modules/graphics/src/c/Plo3d.c
*/
if (m3n * n3n == m3 * n3)
{
izcol = 2 ;
}
break;
default :
OverLoad(3);
return 0;
}
}
iflag_def[1] = 8;
GetOptionalDoubleArg(pvApiCtx, fname, 4, "theta", &theta, 1, opts);
GetOptionalDoubleArg(pvApiCtx, fname, 5, "alpha", &alpha, 1, opts);
GetLabels(pvApiCtx, fname, 6, opts, &legend);
GetOptionalIntArg(pvApiCtx, fname, 7, "flag", &iflag, 3, opts);
GetOptionalDoubleArg(pvApiCtx, fname, 8, "ebox", &ebox, 6, opts);
if (m1 * n1 == m3 * n3 && m1 * n1 == m2 * n2 && m1 * n1 != 1)
{
if (! (m1 == m2 && m2 == m3 && n1 == n2 && n2 == n3))
{
Scierror(999, _("%s: Wrong value for input arguments #%d, #%d and #%d: Incompatible length.\n"), fname, 1, 2, 3);
return 1;
}
}
else
{
if (m2 * n2 != n3)
{
Scierror(999, _("%s: Wrong value for input arguments #%d and #%d: Incompatible length.\n"), fname, 2, 3);
return 1;
}
if (m1 * n1 != m3)
{
Scierror(999, _("%s: Wrong value for input arguments #%d and #%d: Incompatible length.\n"), fname, 1, 3);
return 1;
}
if (m1 * n1 <= 1 || m2 * n2 <= 1)
{
Scierror(999, _("%s: Wrong size for input arguments #%d and #%d: %s expected.\n"), fname, 2, 3, ">= 2");
return 1;
}
}
if (m1 * n1 == 0 || m2 * n2 == 0 || m3 * n3 == 0)
{
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
getOrCreateDefaultSubwin();
/******************** 24/05/2002 ********************/
if (m1 * n1 == m3 * n3 && m1 * n1 == m2 * n2 && m1 * n1 != 1) /* NG beg */
{
isfac = 1;
}
else
{
isfac = 0;
}
Objplot3d (fname, &isfac, &izcol, (l1), (l2), (l3), zcol, &m3, &n3, theta, alpha, legend, iflag, ebox, &m1, &n1, &m2, &n2, &m3, &n3, &m3n, &n3n); /*Adding F.Leray 12.03.04 and 19.03.04*/
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_figure(char * fname, void* pvApiCtx)
{
SciErr sciErr;
int* piAddr = NULL;
int iFig = 0;
int iRhs = nbInputArgument(pvApiCtx);
int iId = 0;
int iPos = 0;
int i = 0;
int iAxes = 0;
int iPropertyOffset = 0;
BOOL bDoCreation = TRUE;
BOOL bVisible = TRUE; // Create a visible figure by default
BOOL bDockable = TRUE; // Create a dockable figure by default
BOOL bDefaultAxes = TRUE; // Create an Axes by default
double* figureSize = NULL;
double* axesSize = NULL;
double* position = NULL;
double val[4];
BOOL bMenuBar = TRUE;
BOOL bToolBar = TRUE;
BOOL bInfoBar = TRUE;
BOOL bResize = TRUE;
int iMenubarType = 1; // Create a 'figure' menubar by default
int iToolbarType = 1; // Create a 'figure' toolbar by default
double dblId = 0;
BOOL status = FALSE;
//figure(num) -> scf(num)
//figure() -> scf()
//figure(x, "...", ...)
// figure()
if (iRhs == 0) // Auto ID
{
iId = getValidDefaultFigureId();
iFig = createNewFigureWithAxes();
setGraphicObjectProperty(iFig, __GO_ID__, &iId, jni_int, 1);
iAxes = setDefaultProperties(iFig, TRUE);
initBar(iFig, bMenuBar, bToolBar, bInfoBar);
createScalarHandle(pvApiCtx, iRhs + 1, getHandle(iFig));
AssignOutputVariable(pvApiCtx, 1) = iRhs + 1;
ReturnArguments(pvApiCtx);
return 0;
}
if (iRhs == 1)
{
//figure(x);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (isVarMatrixType(pvApiCtx, piAddr) == 0)
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer value expected.\n"), fname, 1);
return 0;
}
if (getScalarDouble(pvApiCtx, piAddr, &dblId))
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
iId = (int)(dblId + 0.5); //avoid 1.999 -> 1
//get current fig from id
iFig = getFigureFromIndex(iId);
if (iFig == 0) // Figure does not exists, create a new one
{
iFig = createNewFigureWithAxes();
setGraphicObjectProperty(iFig, __GO_ID__, &iId, jni_int, 1);
iAxes = setDefaultProperties(iFig, TRUE);
}
initBar(iFig, bMenuBar, bToolBar, bInfoBar);
createScalarHandle(pvApiCtx, iRhs + 1, getHandle(iFig));
AssignOutputVariable(pvApiCtx, 1) = iRhs + 1;
ReturnArguments(pvApiCtx);
return 0;
}
// Prepare property analysis
if (iRhs % 2 == 0)
{
//get highest value of winsid to create the new windows @ + 1
iId = getValidDefaultFigureId();
iPos = 0;
}
else
{
iPos = 1;
//figure(x, ...);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (isVarMatrixType(pvApiCtx, piAddr) == 0)
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer value expected.\n"), fname, 1);
return 0;
}
if (getScalarDouble(pvApiCtx, piAddr, &dblId))
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
iId = (int)(dblId + 0.5); //avoid 1.999 -> 1
//get current fig from id
iFig = getFigureFromIndex(iId);
if (iFig != 0) // Figure already exists
{
bDoCreation = FALSE;
}
}
if (bDoCreation)
{
int* piAddrProp = NULL;
char* pstProName = NULL;
int* piAddrData = NULL;
for (i = iPos + 1 ; i <= iRhs ; i += 2)
{
//get property name
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddrProp);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddrProp, &pstProName))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i);
return 1;
}
if (stricmp(pstProName, "dockable") != 0 &&
stricmp(pstProName, "toolbar") != 0 &&
stricmp(pstProName, "menubar") != 0 &&
stricmp(pstProName, "default_axes") != 0 &&
stricmp(pstProName, "visible") != 0 &&
stricmp(pstProName, "figure_size") != 0 &&
stricmp(pstProName, "axes_size") != 0 &&
stricmp(pstProName, "position") != 0 &&
stricmp(pstProName, "menubar_visible") != 0 &&
stricmp(pstProName, "toolbar_visible") != 0 &&
stricmp(pstProName, "resize") != 0 &&
stricmp(pstProName, "infobar_visible") != 0)
{
freeAllocatedSingleString(pstProName);
continue;
}
//get address of value on stack
sciErr = getVarAddressFromPosition(pvApiCtx, i + 1, &piAddrData);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
//check property value to compatibility
if (stricmp(pstProName, "dockable") == 0)
{
bDockable = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bDockable == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "dockable", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "toolbar") == 0)
{
char* pstVal = NULL;
if (isStringType(pvApiCtx, piAddrData) == FALSE || isScalar(pvApiCtx, piAddrData) == FALSE)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i);
freeAllocatedSingleString(pstProName);
}
if (getAllocatedSingleString(pvApiCtx, piAddrData, &pstVal))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
if (stricmp(pstVal, "none") == 0)
{
iToolbarType = 0;
}
else if (stricmp(pstVal, "figure") == 0)
{
iToolbarType = 1;
}
else
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "toolbar", "none", "figure");
freeAllocatedSingleString(pstProName);
freeAllocatedSingleString(pstVal);
return 1;
}
freeAllocatedSingleString(pstVal);
}
else if (stricmp(pstProName, "menubar") == 0)
{
char* pstVal = NULL;
if (isStringType(pvApiCtx, piAddrData) == FALSE || isScalar(pvApiCtx, piAddrData) == FALSE)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddrData, &pstVal))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
if (stricmp(pstVal, "none") == 0)
{
iMenubarType = 0;
}
else if (stricmp(pstVal, "figure") == 0)
{
iMenubarType = 1;
}
else
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "menubar", "none", "figure");
freeAllocatedSingleString(pstProName);
freeAllocatedSingleString(pstVal);
return 1;
}
freeAllocatedSingleString(pstVal);
}
else if (stricmp(pstProName, "default_axes") == 0)
{
bDefaultAxes = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bDefaultAxes == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "default_axes", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "visible") == 0)
{
bVisible = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bVisible == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "visible", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "figure_size") == 0)
{
int iRows = 0;
int iCols = 0;
if (isDoubleType(pvApiCtx, piAddrData) == FALSE)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A double vector expected.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
getMatrixOfDouble(pvApiCtx, piAddrData, &iRows, &iCols, &figureSize);
if (iRows * iCols != 2)
{
Scierror(999, _("Wrong size for '%s' property: %d elements expected.\n"), "figure_size", 2);
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "axes_size") == 0)
{
int iRows = 0;
int iCols = 0;
if (isDoubleType(pvApiCtx, piAddrData) == FALSE)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A double vector expected.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
getMatrixOfDouble(pvApiCtx, piAddrData, &iRows, &iCols, &axesSize);
if (iRows * iCols != 2)
{
Scierror(999, _("Wrong size for '%s' property: %d elements expected.\n"), "axes_size", 2);
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "position") == 0)
{
int iRows = 0;
int iCols = 0;
double* pdbl = NULL;
if (isDoubleType(pvApiCtx, piAddrData))
{
getMatrixOfDouble(pvApiCtx, piAddrData, &iRows, &iCols, &pdbl);
if (iRows * iCols != 4)
{
Scierror(999, _("Wrong size for '%s' property: %d elements expected.\n"), "position", 4);
freeAllocatedSingleString(pstProName);
return 1;
}
position = pdbl;
axesSize = (pdbl + 2);
}
else if (isStringType(pvApiCtx, piAddrData) && isScalar(pvApiCtx, piAddrData))
{
char* pstVal = NULL;
int iVal = 0;
if (getAllocatedSingleString(pvApiCtx, piAddrData, &pstVal))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
iVal = sscanf(pstVal, "%lf|%lf|%lf|%lf", &val[0], &val[1], &val[2], &val[3]);
freeAllocatedSingleString(pstVal);
if (iVal != 4)
{
Scierror(999, _("Wrong value for '%s' property: string or 1 x %d real row vector expected.\n"), "position", 4);
freeAllocatedSingleString(pstProName);
return 1;
}
position = val;
axesSize = (val + 2);
}
else
{
Scierror(999, _("Wrong value for '%s' property: string or 1 x %d real row vector expected.\n"), "position", 4);
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "resize") == 0)
{
bResize = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bResize == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "resize", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "menubar_visible") == 0)
{
bMenuBar = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bMenuBar == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "menubar_visible", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "toolbar_visible") == 0)
{
bToolBar = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bToolBar == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "toolbar_visible", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
else if (stricmp(pstProName, "infobar_visible") == 0)
{
bInfoBar = getStackArgumentAsBoolean(pvApiCtx, piAddrData);
if (bInfoBar == -1)
{
Scierror(999, _("Wrong value for '%s' property: '%s' or '%s' expected."), "infobar_visible", "on", "off");
freeAllocatedSingleString(pstProName);
return 1;
}
}
freeAllocatedSingleString(pstProName);
}
iFig = createFigure(bDockable, iMenubarType, iToolbarType, bDefaultAxes, bVisible);
setGraphicObjectProperty(iFig, __GO_ID__, &iId, jni_int, 1);
iAxes = setDefaultProperties(iFig, bDefaultAxes);
}
//set(iFig, iPos, iPos + 1)
for (i = iPos + 1 ; i <= iRhs ; i += 2)
{
int isMatrixOfString = 0;
int* piAddrProp = NULL;
char* pstProName = NULL;
int* piAddrData = NULL;
int iRows = 0;
int iCols = 0;
void* _pvData = NULL;
int iType = 0;
//get property name
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddrProp);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddrProp, &pstProName))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, i);
return 1;
}
if (bDoCreation && (
stricmp(pstProName, "dockable") == 0 ||
stricmp(pstProName, "toolbar") == 0 ||
stricmp(pstProName, "menubar") == 0 ||
stricmp(pstProName, "default_axes") == 0 ||
stricmp(pstProName, "visible") == 0 ||
stricmp(pstProName, "figure_size") == 0 ||
stricmp(pstProName, "axes_size") == 0 ||
stricmp(pstProName, "position") == 0 ||
stricmp(pstProName, "resize") == 0 ||
stricmp(pstProName, "menubar_visible") == 0 ||
stricmp(pstProName, "toolbar_visible") == 0 ||
stricmp(pstProName, "infobar_visible") == 0))
{
// Already set creating new figure
// but let the set_ function fail if figure already exists
freeAllocatedSingleString(pstProName);
continue;
}
//get address of value on stack
sciErr = getVarAddressFromPosition(pvApiCtx, i + 1, &piAddrData);
if (sciErr.iErr)
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i + 1);
freeAllocatedSingleString(pstProName);
return 1;
}
getVarType(pvApiCtx, piAddrData, &iType);
if ((strcmp(pstProName, "user_data") == 0) || (stricmp(pstProName, "userdata") == 0))
{
/* in this case set_user_data_property
* directly uses the third position in the stack
* to get the variable which is to be set in
* the user_data property (any data type is allowed) S. Steer */
_pvData = (void*)piAddrData; /*position in the stack */
iRows = -1; /*unused */
iCols = -1; /*unused */
iType = -1;
}
else
{
switch (iType)
{
case sci_matrix :
getMatrixOfDouble(pvApiCtx, piAddrData, &iRows, &iCols, (double**)&_pvData);
break;
case sci_boolean :
getMatrixOfBoolean(pvApiCtx, piAddrData, &iRows, &iCols, (int**)&_pvData);
break;
case sci_handles :
getMatrixOfHandle(pvApiCtx, piAddrData, &iRows, &iCols, (long long**)&_pvData);
break;
case sci_strings :
if ( strcmp(pstProName, "tics_labels") != 0 && strcmp(pstProName, "auto_ticks") != 0 &&
strcmp(pstProName, "axes_visible") != 0 && strcmp(pstProName, "axes_reverse") != 0 &&
strcmp(pstProName, "text") != 0 && stricmp(pstProName, "string") != 0 &&
stricmp(pstProName, "tooltipstring") != 0) /* Added for uicontrols */
{
if (getAllocatedSingleString(pvApiCtx, piAddrData, (char**)&_pvData))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A single string expected.\n"), fname, 3);
freeAllocatedSingleString(pstProName);
return 1;
}
iRows = (int)strlen((char*)_pvData);
iCols = 1;
}
else
{
isMatrixOfString = 1;
if (getAllocatedMatrixOfString(pvApiCtx, piAddrData, &iRows, &iCols, (char***)&_pvData))
{
Scierror(999, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 3);
freeAllocatedSingleString(pstProName);
return 1;
}
}
break;
case sci_list :
iCols = 1;
getListItemNumber(pvApiCtx, piAddrData, &iRows);
_pvData = (void*)piAddrData; /* In this case l3 is the list position in stack */
break;
default :
_pvData = (void*)piAddrData; /* In this case l3 is the list position in stack */
break;
}
}
callSetProperty(pvApiCtx, iFig, _pvData, iType, iRows, iCols, pstProName);
// If backgroundcolor is set :
// * add it to colormap => performed by callSetProperty
// * set background to index => performed by callSetProperty
// * copy value into axes background property
if (stricmp(pstProName, "backgroundcolor") == 0 && iAxes > 0)
{
int iBackground = 0;
int *piBackground = &iBackground;
getGraphicObjectProperty(iFig, __GO_BACKGROUND__, jni_int, (void **)&piBackground);
setGraphicObjectProperty(iAxes, __GO_BACKGROUND__, piBackground, jni_int, 1);
}
freeAllocatedSingleString(pstProName);
if (iType == sci_strings)
{
//free allacted data
if (isMatrixOfString == 1)
{
freeAllocatedMatrixOfString(iRows, iCols, (char**)_pvData);
}
else
{
freeAllocatedSingleString((char*)_pvData);
}
}
}
if (position)
{
int pos[2];
pos[0] = (int)position[0];
pos[1] = (int)position[1];
setGraphicObjectProperty(iFig, __GO_POSITION__, pos, jni_int_vector, 2);
}
//axes_size
if (axesSize)
{
int axes[2];
axes[0] = (int)axesSize[0];
axes[1] = (int)axesSize[1];
setGraphicObjectProperty(iFig, __GO_AXES_SIZE__, axes, jni_int_vector, 2);
}
else //no size, use default axes_size
{
int* piAxesSize = NULL;
getGraphicObjectProperty(getFigureModel(), __GO_AXES_SIZE__, jni_int_vector, (void **)&piAxesSize);
setGraphicObjectProperty(iFig, __GO_AXES_SIZE__, piAxesSize, jni_int_vector, 2);
releaseGraphicObjectProperty(__GO_AXES_SIZE__, piAxesSize, jni_int_vector, 2);
}
initBar(iFig, bMenuBar, bToolBar, bInfoBar);
if (axesSize == NULL && figureSize) //figure_size
{
int figure[2];
figure[0] = (int)figureSize[0];
figure[1] = (int)figureSize[1];
setGraphicObjectProperty(iFig, __GO_SIZE__, figure, jni_int_vector, 2);
}
setGraphicObjectProperty(iFig, __GO_RESIZE__, (void*)&bResize, jni_bool, 1);
//return new created fig
createScalarHandle(pvApiCtx, iRhs + 1, getHandle(iFig));
AssignOutputVariable(pvApiCtx, 1) = iRhs + 1;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
SciErr getDimFromVar(void *_pvCtx, int *_piAddress, int *_piVal)
{
SciErr sciErr;
sciErr.iErr = 0;
sciErr.iMsgCount = 0;
int iType = 0;
int iRows = 0;
int iCols = 0;
double *pdblReal = NULL;
sciErr = getVarType(_pvCtx, _piAddress, &iType);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_DIMFROMVAR, _("%s: Unable to get argument type"), "getDimFromVar");
return sciErr;
}
if (iType == sci_matrix)
{
if (isVarComplex(_pvCtx, _piAddress))
{
addErrorMessage(&sciErr, API_ERROR_GET_DIMFROMVAR, _("%s: Wrong type for argument %d: Real matrix expected.\n"), "getDimFromVar",
getRhsFromAddress(_pvCtx, _piAddress));
return sciErr;
}
sciErr = getMatrixOfDouble(_pvCtx, _piAddress, &iRows, &iCols, &pdblReal);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_DIMFROMVAR, _("%s: Unable to get argument data"), "getDimFromVar");
return sciErr;
}
*_piVal = (int)Max(pdblReal[0], 0);
}
else if (iType == sci_ints)
{
int iPrec = 0;
sciErr = getVarDimension(_pvCtx, _piAddress, &iRows, &iCols);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_DIMFROMVAR, _("%s: Unable to get argument dimension"), "getDimFromVar");
return sciErr;
}
if (iRows != 1 || iCols != 1)
{
addErrorMessage(&sciErr, API_ERROR_GET_DIMFROMVAR, _("%s: Wrong size for argument %d: (%d,%d) expected.\n"), "getProcessMode",
getRhsFromAddress(_pvCtx, _piAddress), 1, 1);
return sciErr;
}
sciErr = getMatrixOfIntegerPrecision(_pvCtx, _piAddress, &iPrec);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_DIMFROMVAR, _("%s: Unable to get argument precision"), "getDimFromVar");
return sciErr;
}
switch (iPrec)
{
case SCI_INT8:
{
char *pcData = NULL;
sciErr = getMatrixOfInteger8(_pvCtx, _piAddress, &iRows, &iCols, &pcData);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_DIMFROMVAR, _("%s: Unable to get argument data"), "getDimFromVar");
return sciErr;
}
*_piVal = pcData[0];
}
break;
case SCI_UINT8:
{
unsigned char *pucData = NULL;
sciErr = getMatrixOfUnsignedInteger8(_pvCtx, _piAddress, &iRows, &iCols, &pucData);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_DIMFROMVAR, _("%s: Unable to get argument data"), "getDimFromVar");
return sciErr;
}
*_piVal = pucData[0];
}
break;
case SCI_INT16:
{
short *psData = NULL;
sciErr = getMatrixOfInteger16(_pvCtx, _piAddress, &iRows, &iCols, &psData);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_DIMFROMVAR, _("%s: Unable to get argument data"), "getDimFromVar");
return sciErr;
}
*_piVal = psData[0];
}
break;
case SCI_UINT16:
{
unsigned short *pusData = NULL;
sciErr = getMatrixOfUnsignedInteger16(_pvCtx, _piAddress, &iRows, &iCols, &pusData);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_DIMFROMVAR, _("%s: Unable to get argument data"), "getDimFromVar");
return sciErr;
}
*_piVal = pusData[0];
}
break;
case SCI_INT32:
{
int *piData = NULL;
sciErr = getMatrixOfInteger32(_pvCtx, _piAddress, &iRows, &iCols, &piData);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_DIMFROMVAR, _("%s: Unable to get argument data"), "getDimFromVar");
return sciErr;
}
*_piVal = piData[0];
}
break;
case SCI_UINT32:
{
unsigned int *puiData = NULL;
sciErr = getMatrixOfUnsignedInteger32(_pvCtx, _piAddress, &iRows, &iCols, &puiData);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_DIMFROMVAR, _("%s: Unable to get argument data"), "getDimFromVar");
return sciErr;
}
*_piVal = puiData[0];
}
break;
}
}
else
{
addErrorMessage(&sciErr, API_ERROR_GET_DIMFROMVAR, _("%s: Wrong type for input argument #%d: A real scalar or an integer scalar expected.\n"),
"getDimFromVar", getRhsFromAddress(_pvCtx, _piAddress));
return sciErr;
}
return sciErr;
}
/**
* Older generic interface to DCDLIB's cdf functions.
* @param fname scilab caller's function name
* @param inarg number of inputs to the scilab call
* @param oarg number of outputs begged by the scilab call
* @param shift tells how much arglist has to be shifted in DCDFLIB funcall
* @param which of the arguments is to be deduced from the others
* @param fun actual computation function
* @return error code
*/
int CdfBase(char const * const fname, void* pvApiCtx, int inarg, int oarg, int shift, int which, int (*fun)(int*, ...))
{
#define MAXARG 6
double *data[MAXARG];
int rows[MAXARG], cols[MAXARG];
#undef MAXARG
double bound = 0;
int errlevel = 0;
int i = 0;
int *p = NULL;
int siz = strlen(fname);
int *df;
int row, col;
double *datas;
int resc;
int pos = 0;
int pos1 = 0;
char *option = create_string(pvApiCtx, 1);
if ( Rhs != inarg + 1 )
{
Scierror(999, _("%s: Wrong number of input argument(s): %d expected.\n"), fname, inarg + 1);
return 1;
}
for (i = 0; i < inarg; ++i)
{
int j = 0;
getVarAddressFromPosition(pvApiCtx, i + 2, &p);
getMatrixOfDouble(pvApiCtx, p, &rows[i], &cols[i], &data[i]);
}
for (i = 1; i < inarg ; ++i)
{
if (rows[i] != rows[i - 1] || cols[i] != cols[i - 1])
{
Scierror(999, _("%s: Incompatible input arguments #%d and #%d': Same sizes expected.\n"), fname, i + 1, i + 2);
return 1;
}
}
for (i = 0; i < oarg; ++i)
{
allocMatrixOfDouble(pvApiCtx, Rhs + i + 1, rows[0], cols[0], &data[i + inarg]);
}
//check which scilab function is called
switch (siz)
{
case 4:
//cdff
if (fname[3] == 'f')
{
if (strcmp(option, "PQ") == 0)
{
pos = 3;
pos1 = 4;
}
else if (strcmp(option, "F") == 0)
{
pos = 2;
pos1 = 3;
}
else if (strcmp(option, "Dfn") == 0)
{
pos = 2;
}
else if (strcmp(option, "Dfd") == 0)
{
pos = 5;
}
}
//cdft
else
{
if (strcmp(option, "PQ") == 0)
{
pos = 3;
}
else if (strcmp(option, "T") == 0)
{
pos = 2;
}
}
break;
case 6 :
//cdfbet
if (fname[4] == 'e')
{
}
//cdfbin
else if (fname[4] == 'i')
{
}
//cdffnc
else if (fname[4] == 'n')
{
if (strcmp(option, "PQ") == 0)
{
pos = 3;
pos1 = 4;
}
else if (strcmp(option, "F") == 0)
{
pos = 2;
pos1 = 3;
}
else if (strcmp(option, "Dfn") == 0)
{
pos = 2;
}
else if (strcmp(option, "Dfd") == 0)
{
pos = 6;
}
else if (strcmp(option, "Pnonc") == 0)
{
pos = 5;
pos1 = 6;
}
}
//cdfgam
else if (fname[4] == 'a')
{
}
//cdfnbn
else if (fname[4] == 'b')
{
}
else if (fname[4] == 'h')
{
//cdfchi
if (fname[5] == 'i')
{
if (strcmp(option, "PQ") == 0)
{
pos = 3;
}
else if (strcmp(option, "X") == 0)
{
pos = 2;
}
}
//cdfchn
else
{
if (strcmp(option, "PQ") == 0)
{
pos = 3;
}
else if (strcmp(option, "X") == 0)
{
pos = 2;
}
else if (strcmp(option, "Pnonc") == 0)
{
pos = 5;
}
}
}
else
{
//cdfnor
if (fname[5] == 'r')
{
}
//cdfpoi
else
{
}
}
break;
}
if (pos != 0)
{
getVarAddressFromPosition(pvApiCtx, pos, &df);
getMatrixOfDouble(pvApiCtx, df, &row, &col, &datas);
resc = checkInteger(row, col, datas, pos, fname);
if (resc == 1)
{
Sciwarning(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, pos);
}
}
if (pos1 != 0)
{
getVarAddressFromPosition(pvApiCtx, pos1, &df);
getMatrixOfDouble(pvApiCtx, df, &row, &col, &datas);
resc = checkInteger(row, col, datas, pos1, fname);
if (resc == 1)
{
Sciwarning(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, pos1);
}
}
#define callpos(i) rotate(i, shift, inarg + oarg)
for (i = 0; i < rows[0] * cols[0]; ++i)
{
switch (inarg + oarg)
{
case 4: /* cdfchi, cdfpoi, cdft */
(*fun)(&which, &(data[callpos(0)][i]), &(data[callpos(1)][i]), &(data[callpos(2)][i]), &(data[callpos(3)][i]), &errlevel, &bound);
break;
case 5: /* cdfchn, cdff, cdfgam, cdfnor */
(*fun)(&which, &(data[callpos(0)][i]), &(data[callpos(1)][i]), &(data[callpos(2)][i]), &(data[callpos(3)][i]), &(data[callpos(4)][i]), &errlevel, &bound);
break;
case 6: /* cdfbet, cdfbin, cdffnc, cdfnbn, */
(*fun)(&which, &(data[callpos(0)][i]), &(data[callpos(1)][i]), &(data[callpos(2)][i]), &(data[callpos(3)][i]), &(data[callpos(4)][i]), &(data[callpos(5)][i]), &errlevel, &bound);
break;
}
if (errlevel != 0)
{
cdf_error(fname, errlevel, bound);
return 1;
}
}
#undef callpos
for (i = 0; i < oarg; ++i)
{
LhsVar(i + 1) = Rhs + i + 1;
}
PutLhsVar();
return 0;
}
