int read_sparse(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int i, j, k;
int* piAddr = NULL;
int iRows = 0;
int iCols = 0;
int iNbItem = 0;
int* piNbItemRow = NULL;
int* piColPos = NULL;
double* pdblReal = NULL;
double* pdblImg = NULL;
CheckInputArgument(pvApiCtx, 1, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if (isVarComplex(pvApiCtx, piAddr))
{
sciErr = getComplexSparseMatrix(pvApiCtx, piAddr, &iRows, &iCols, &iNbItem, &piNbItemRow, &piColPos, &pdblReal, &pdblImg);
}
else
{
sciErr = getSparseMatrix(pvApiCtx, piAddr, &iRows, &iCols, &iNbItem, &piNbItemRow, &piColPos, &pdblReal);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciprint("Sparse %d item(s)\n", iNbItem);
k = 0;
for (i = 0 ; i < iRows ; i++)
{
for (j = 0 ; j < piNbItemRow[i] ; j++)
{
sciprint("(%d,%d) = %f", i + 1, piColPos[k], pdblReal[k]);
if (isVarComplex(pvApiCtx, piAddr))
{
sciprint(" %+fi", pdblImg[k]);
}
sciprint("\n");
k++;
}
}
//assign allocated variables to Lhs position
AssignOutputVariable(pvApiCtx, 1) = 0;
return 0;
}
/*--------------------------------------------------------------------------*/
int checkParam(void* _pvCtx, int _iPos, char* fname)
{
SciErr sciErr;
int* piAddr = NULL;
//get var address
sciErr = getVarAddressFromPosition(_pvCtx, _iPos, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, _iPos);
return 1;
}
//check is real scalar double
if ( isScalar(_pvCtx, piAddr) == 0 ||
isDoubleType(_pvCtx, piAddr) == 0 ||
isVarComplex(_pvCtx, piAddr) == 1)
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer value expected.\n"), fname, _iPos);
return 1;
}
return 0;
}
int getFixedSizeDoubleMatrixFromScilab(int argNum, int rows, int cols, double **dest)
{
int *varAddress,inputMatrixRows,inputMatrixCols;
SciErr sciErr;
const char errMsg[]="Wrong type for input argument #%d: A matrix of double of size %d by %d is expected.\n";
const int errNum=999;
//same steps as above
sciErr = getVarAddressFromPosition(pvApiCtx, argNum, &varAddress);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if ( !isDoubleType(pvApiCtx,varAddress) || isVarComplex(pvApiCtx,varAddress) )
{
Scierror(errNum,errMsg,argNum,rows,cols);
return 1;
}
sciErr = getMatrixOfDouble(pvApiCtx, varAddress, &inputMatrixRows, &inputMatrixCols,NULL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
//check that the matrix has the correct number of rows and columns
if(inputMatrixRows!=rows || inputMatrixCols!=cols)
{
Scierror(errNum,errMsg,argNum,rows,cols);
return 1;
}
getMatrixOfDouble(pvApiCtx, varAddress, &inputMatrixRows, &inputMatrixCols, dest);
return 0;
}
int getDoubleMatrixFromScilab(int argNum, int *rows, int *cols, double **dest)
{
int *varAddress;
SciErr sciErr;
const char errMsg[]="Wrong type for input argument #%d: A matrix of double is expected.\n";
const int errNum=999;
//same steps as above
sciErr = getVarAddressFromPosition(pvApiCtx, argNum, &varAddress);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if ( !isDoubleType(pvApiCtx,varAddress) || isVarComplex(pvApiCtx,varAddress) )
{
Scierror(errNum,errMsg,argNum);
return 1;
}
getMatrixOfDouble(pvApiCtx, varAddress, rows, cols, dest);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
return 0;
}
int getDoubleFromScilab(int argNum, double *dest)
{
//data declarations
SciErr sciErr;
int iRet,*varAddress;
const char errMsg[]="Wrong type for input argument #%d: A double is expected.\n";
const int errNum=999;
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, argNum, &varAddress);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
//check that it is a non-complex double
if ( !isDoubleType(pvApiCtx,varAddress) || isVarComplex(pvApiCtx,varAddress) )
{
Scierror(errNum,errMsg,argNum);
return 1;
}
//retrieve and store
iRet = getScalarDouble(pvApiCtx, varAddress, dest);
if(iRet)
{
Scierror(errNum,errMsg,argNum);
return 1;
}
return 0;
}
int getIntFromScilab(int argNum, int *dest)
{
SciErr sciErr;
int iRet,*varAddress;
double inputDouble;
const char errMsg[]="Wrong type for input argument #%d: An integer is expected.\n";
const int errNum=999;
//same steps as above
sciErr = getVarAddressFromPosition(pvApiCtx, argNum, &varAddress);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if ( !isDoubleType(pvApiCtx,varAddress) || isVarComplex(pvApiCtx,varAddress) )
{
Scierror(errNum,errMsg,argNum);
return 1;
}
iRet = getScalarDouble(pvApiCtx, varAddress, &inputDouble);
//check that an int is stored in the double by casting and recasting
if(iRet || ((double)((int)inputDouble))!=inputDouble)
{
Scierror(errNum,errMsg,argNum);
return 1;
}
*dest=(int)inputDouble;
return 0;
}
int getGenerateSize(void* pvApiCtx, int* _piAddress)
{
SciErr sciErr;
int iRet = 0;
int iRows = 0;
int iCols = 0;
double* pdblReal = NULL;
double* pdblImg = NULL;
if (isVarComplex(pvApiCtx, _piAddress))
{
sciErr = getComplexMatrixOfDouble(pvApiCtx, _piAddress, &iRows, &iCols, &pdblReal, &pdblImg);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, _piAddress, &iRows, &iCols, &pdblReal);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
}
return abs((int)pdblReal[0]);
}
// =============================================================================
int csv_isDoubleScalar(void* _pvCtx, int _iVar)
{
SciErr sciErr;
int *piAddressVar = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, _iVar, &piAddressVar);
if (sciErr.iErr)
{
return 0;
}
if (csv_isScalar(_pvCtx, _iVar))
{
int iType = 0;
sciErr = getVarType(pvApiCtx, piAddressVar, &iType);
if (sciErr.iErr)
{
return 0;
}
if (isVarComplex(pvApiCtx, piAddressVar) == 0)
{
return (iType == sci_matrix);
}
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_dlgamma(char *fname, unsigned long fname_len)
{
SciErr sciErr;
double* lX = NULL;
int* piAddrX = NULL;
int iType1 = 0;
int MX = 0, NX = 0, i = 0;
nbInputArgument(pvApiCtx) = Max(0, nbInputArgument(pvApiCtx));
CheckInputArgument(pvApiCtx, 1, 1);
CheckOutputArgument(pvApiCtx, 1, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrX);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddrX, &iType1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
if ((iType1 == sci_list) || (iType1 == sci_tlist) || (iType1 == sci_mlist))
{
OverLoad(1);
return 0;
}
if (isVarComplex(pvApiCtx, piAddrX))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real expected.\n"), fname, 1);
return 1;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddrX, &MX, &NX, &lX);
if (sciErr.iErr)
{
Scierror(999, _("%s: Wrong type for argument %d: A matrix expected.\n"), fname, 1);
}
for (i = 0; i < MX * NX; i++)
{
lX[i] = C2F(psi)(lX + i);
}
AssignOutputVariable(pvApiCtx, 1) = 1;
returnArguments(pvApiCtx);
return 0;
}
int get_sparse_info(void* _pvCtx, int _iRhs, int* _piParent, int *_piAddr, int _iItemPos)
{
SciErr sciErr;
int iRows = 0;
int iCols = 0;
int iItem = 0;
int* piNbRow = NULL;
int* piColPos = NULL;
double* pdblReal = NULL;
double* pdblImg = NULL;
if (_iItemPos == 0)
{
//Not in list
if (isVarComplex(_pvCtx, _piAddr))
{
sciErr = getComplexSparseMatrix(_pvCtx, _piAddr, &iRows, &iCols, &iItem, &piNbRow, &piColPos, &pdblReal, &pdblImg);
}
else
{
sciErr = getSparseMatrix(_pvCtx, _piAddr, &iRows, &iCols, &iItem, &piNbRow, &piColPos, &pdblReal);
}
}
else
{
if (isVarComplex(_pvCtx, _piAddr))
{
sciErr = getComplexSparseMatrixInList(_pvCtx, _piParent, _iItemPos, &iRows, &iCols, &iItem, &piNbRow, &piColPos, &pdblReal, &pdblImg);
}
else
{
sciErr = getSparseMatrixInList(_pvCtx, _piParent, _iItemPos, &iRows, &iCols, &iItem, &piNbRow, &piColPos, &pdblReal);
}
}
FREE(piNbRow);
FREE(piColPos);
FREE(pdblReal);
FREE(pdblImg);
insert_indent();
sciprint("Sparse (%d x %d), Item(s) : %d \n", iRows, iCols, iItem);
return 0;;
}
int sci_sym_setObjSense(char *fname){
//error management variable
SciErr sciErr;
int iRet;
//data declarations
int *varAddress;
double objSense;
//ensure that environment is active
if(global_sym_env==NULL){
sciprint("Error: Symphony environment not initialized. Please run 'sym_open()' first.\n");
return 1;
}
//code to check arguments and get them
CheckInputArgument(pvApiCtx,1,1) ;
CheckOutputArgument(pvApiCtx,1,1) ;
//code to process input
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &varAddress);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if ( !isDoubleType(pvApiCtx,varAddress) || isVarComplex(pvApiCtx,varAddress) )
{
Scierror(999, "Wrong type for input argument #1:\nEither 1 (sym_minimize) or -1 (sym_maximize) is expected.\n");
return 1;
}
iRet = getScalarDouble(pvApiCtx, varAddress, &objSense);
if(iRet || (objSense!=-1 && objSense!=1))
{
Scierror(999, "Wrong type for input argument #1:\nEither 1 (sym_minimize) or -1 (sym_maximize) is expected.\n");
return 1;
}
iRet=sym_set_obj_sense(global_sym_env,objSense);
if(iRet==FUNCTION_TERMINATED_ABNORMALLY){
Scierror(999, "An error occured.\n");
return 1;
}else{
if(objSense==1)
sciprint("The solver has been set to minimize the objective.\n");
else
sciprint("The solver has been set to maximize the objective.\n");
}
//code to give output
if(return0toScilab())
return 1;
return 0;
}
int get_double_info(void* _pvCtx, int _iRhs, int* _piParent, int *_piAddr, int _iItemPos)
{
SciErr sciErr;
int iRows = 0;
int iCols = 0;
double* pdblReal = NULL;
double* pdblImg = NULL;
if (_iItemPos == 0)
{
//not in list
if (isVarComplex(_pvCtx, _piAddr))
{
sciErr = getComplexMatrixOfDouble(_pvCtx, _piAddr, &iRows, &iCols, &pdblReal, &pdblImg);
}
else
{
sciErr = getMatrixOfDouble(_pvCtx, _piAddr, &iRows, &iCols, &pdblReal);
}
}
else
{
if (isVarComplex(_pvCtx, _piAddr))
{
sciErr = getComplexMatrixOfDoubleInList(_pvCtx, _piParent, _iItemPos, &iRows, &iCols, &pdblReal, &pdblImg);
}
else
{
sciErr = getMatrixOfDoubleInList(_pvCtx, _piParent, _iItemPos, &iRows, &iCols, &pdblReal);
}
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
insert_indent();
sciprint("Double (%d x %d)\n", iRows, iCols);
return 0;;
}
static bool export_double(int _iH5File, int *_piVar, char* _pstName)
{
int iRet = 0;
int iComplex = isVarComplex(pvApiCtx, _piVar);
int piDims[2];
int iType = 0;
double *pdblReal = NULL;
double *pdblImg = NULL;
SciErr sciErr = getVarType(pvApiCtx, _piVar, &iType);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return false;
}
if (iType != sci_matrix)
{
return false;
}
if (iComplex)
{
sciErr = getComplexMatrixOfDouble(pvApiCtx, _piVar, &piDims[0], &piDims[1], &pdblReal, &pdblImg);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return false;
}
iRet = writeDoubleComplexMatrix(_iH5File, _pstName, 2, piDims, pdblReal, pdblImg);
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, _piVar, &piDims[0], &piDims[1], &pdblReal);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return false;
}
iRet = writeDoubleMatrix(_iH5File, _pstName, 2, piDims, pdblReal);
}
if (iRet)
{
return false;
}
char pstMsg[512];
sprintf(pstMsg, "double (%d x %d)", piDims[0], piDims[1]);
print_type(pstMsg);
return true;
}
/*--------------------------------------------------------------------------*/
int isNamedVarComplex(void *_pvCtx, const char *_pstName)
{
int *piAddr = NULL;
SciErr sciErr = getVarAddressFromName(_pvCtx, _pstName, &piAddr);
if (sciErr.iErr)
{
return 0;
}
return isVarComplex(_pvCtx, piAddr);
}
SciErr getComplexZMatrixOfDouble(void* _pvCtx, int* _piAddress, int* _piRows, int* _piCols, doublecomplex** _pdblZ)
{
SciErr sciErr; sciErr.iErr = 0; sciErr.iMsgCount = 0;
double *pdblReal = NULL;
double *pdblImg = NULL;
sciErr = getCommonMatrixOfDouble(_pvCtx, _piAddress, isVarComplex(_pvCtx, _piAddress), _piRows, _piCols, &pdblReal, &pdblImg);
if(sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_ZDOUBLE, _("%s: Unable to get argument #%d"), "getComplexZMatrixOfDouble", getRhsFromAddress(_pvCtx, _piAddress));
return sciErr;
}
*_pdblZ = oGetDoubleComplexFromPointer(pdblReal, pdblImg, *_piRows * *_piCols);
return sciErr;
}
static bool export_sparse(int _iH5File, int *_piVar, char* _pstName)
{
int iRet = 0;
int iNbItem = 0;
int* piNbItemRow = NULL;
int* piColPos = NULL;
double* pdblReal = NULL;
double* pdblImg = NULL;
int piDims[2];
SciErr sciErr;
if (isVarComplex(pvApiCtx, _piVar))
{
sciErr = getComplexSparseMatrix(pvApiCtx, _piVar, &piDims[0], &piDims[1], &iNbItem, &piNbItemRow, &piColPos, &pdblReal, &pdblImg);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return false;
}
iRet = writeSparseComplexMatrix(_iH5File, _pstName, piDims[0], piDims[1], iNbItem, piNbItemRow, piColPos, pdblReal, pdblImg);
}
else
{
sciErr = getSparseMatrix(pvApiCtx, _piVar, &piDims[0], &piDims[1], &iNbItem, &piNbItemRow, &piColPos, &pdblReal);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return false;
}
iRet = writeSparseMatrix(_iH5File, _pstName, piDims[0], piDims[1], iNbItem, piNbItemRow, piColPos, pdblReal);
}
if (iRet)
{
return false;
}
char pstMsg[512];
sprintf(pstMsg, "sparse (%d x %d)", piDims[0], piDims[1]);
print_type(pstMsg);
return true;
}
SciErr getCommonMatrixOfDouble(void* _pvCtx, int* _piAddress, int _iComplex, int* _piRows, int* _piCols, double** _pdblReal, double** _pdblImg)
{
SciErr sciErr; sciErr.iErr = 0; sciErr.iMsgCount = 0;
int iType = 0;
if( _piAddress == NULL)
{
addErrorMessage(&sciErr, API_ERROR_INVALID_POINTER, _("%s: Invalid argument address"), _iComplex ? "getComplexMatrixOfDouble" : "getMatrixOfDouble");
return sciErr;
}
sciErr = getVarType(_pvCtx, _piAddress, &iType);
if(sciErr.iErr || iType != sci_matrix)
{
addErrorMessage(&sciErr, API_ERROR_INVALID_TYPE, _("%s: Invalid argument type, %s excepted"), _iComplex ? "getComplexMatrixOfDouble" : "getMatrixOfDouble", _("double matrix"));
return sciErr;
}
if(isVarComplex(_pvCtx, _piAddress) != _iComplex)
{
addErrorMessage(&sciErr, API_ERROR_INVALID_COMPLEXITY, _("%s: Bad call to get a non complex matrix"), "getComplexMatrixOfDouble");
return sciErr;
}
sciErr = getVarDimension(_pvCtx, _piAddress, _piRows, _piCols);
if(sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_DOUBLE, _("%s: Unable to get argument #%d"), _iComplex ? "getComplexMatrixOfDouble" : "getMatrixOfDouble", getRhsFromAddress(_pvCtx, _piAddress));
return sciErr;
}
if(_pdblReal != NULL)
{
*_pdblReal = (double*)(_piAddress + 4);
}
if(_iComplex && _pdblImg != NULL)
{
*_pdblImg = (double*)(_piAddress + 4) + *_piRows * *_piCols;
}
return sciErr;
}
SciErr getCommonMatrixOfPoly(void* _pvCtx, int* _piAddress, int _iComplex, int* _piRows, int* _piCols, int* _piNbCoef, double** _pdblReal, double** _pdblImg)
{
SciErr sciErr;
sciErr.iErr = 0;
sciErr.iMsgCount = 0;
int iType = 0;
int iSize = 0;
int *piOffset = NULL;
double *pdblReal = NULL;
double *pdblImg = NULL;
if (_piAddress == NULL)
{
addErrorMessage(&sciErr, API_ERROR_INVALID_POINTER, _("%s: Invalid argument address"), _iComplex ? "getComplexMatrixOfPoly" : "getMatrixOfPoly");
return sciErr;
}
sciErr = getVarType(_pvCtx, _piAddress, &iType);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_POLY, _("%s: Unable to get argument #%d"), _iComplex ? "getComplexMatrixOfPoly" : "getMatrixOfPoly", getRhsFromAddress(_pvCtx, _piAddress));
return sciErr;
}
if (iType != sci_poly)
{
addErrorMessage(&sciErr, API_ERROR_INVALID_TYPE, _("%s: Invalid argument type, %s excepted"), _iComplex ? "getComplexMatrixOfPoly" : "getMatrixOfPoly", _("polynomial matrix"));
return sciErr;
}
if (isVarComplex(_pvCtx, _piAddress) != _iComplex)
{
addErrorMessage(&sciErr, API_ERROR_INVALID_COMPLEXITY, _("%s: Bad call to get a non complex matrix"), _iComplex ? "getComplexMatrixOfPoly" : "getMatrixOfPoly");
return sciErr;
}
sciErr = getVarDimension(_pvCtx, _piAddress, _piRows, _piCols);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_GET_POLY, _("%s: Unable to get argument #%d"), _iComplex ? "getComplexMatrixOfPoly" : "getMatrixOfPoly", getRhsFromAddress(_pvCtx, _piAddress));
return sciErr;
}
iSize = *_piRows * *_piCols;
if (_piNbCoef == NULL)
{
return sciErr;
}
piOffset = _piAddress + 8; //4 for header and 4 for variable name
for (int i = 0 ; i < iSize ; i++)
{
_piNbCoef[i] = piOffset[i + 1] - piOffset[i];
}
if (_pdblReal == NULL)
{
return sciErr;
}
pdblReal = (double*)(piOffset + iSize + 1 + ((iSize + 1) % 2 == 0 ? 0 : 1 ));
for (int i = 0 ; i < iSize ; i++)
{
memcpy(_pdblReal[i], pdblReal + piOffset[i] - 1, sizeof(double) * _piNbCoef[i]);
}
if (_iComplex == 1)
{
pdblImg = pdblReal + piOffset[iSize] - 1;
for (int i = 0 ; i < iSize ; i++)
{
memcpy(_pdblImg[i], pdblImg + piOffset[i] - 1, sizeof(double) * _piNbCoef[i]);
}
}
return sciErr;
}
/*--------------------------------------------------------------------------*/
int inteval_cshep2d(char *fname, unsigned long fname_len)
{
/*
* [f [,dfdx, dfdy [, dffdxx, dffdxy, dffdyy]]] = eval_cshep2d(xp, yp, tlcoef)
*/
int minrhs = 3, maxrhs = 3, minlhs = 1, maxlhs = 6;
int mx = 0, nx = 0, lx = 0, my = 0, ny = 0, ly = 0, mt = 0, nt = 0, lt = 0;
char **Str = NULL;
int m1 = 0, n1 = 0, m2 = 0, n2 = 0, m3 = 0, n3 = 0, m4 = 0, n4 = 0, m5 = 0, n5 = 0, m6 = 0, n6 = 0, m7 = 0, n7 = 0, m8 = 0, n8 = 0;
int lxyz = 0, lgrid = 0, lrmax = 0, lrw = 0, la = 0;
double *xp = NULL, *yp = NULL, *xyz = NULL, *grid = NULL, *f = NULL, *dfdx = NULL, *dfdy = NULL, *dffdxx = NULL, *dffdyy = NULL, *dffdxy = NULL;
int i = 0, ier = 0, n = 0, np = 0, nr = 0, lf = 0, ldfdx = 0, ldfdy = 0, ldffdxx = 0, ldffdyy = 0, ldffdxy = 0;
SciIntMat Cell, Next;
int *cell = NULL, *next = NULL;
CheckRhs(minrhs, maxrhs);
CheckLhs(minlhs, maxlhs);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &my, &ny, &ly);
for (i = 1; i <= minrhs - 1; i++)
{
SciErr sciErr;
int *piAddressVar = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 0;
}
if (isVarComplex(pvApiCtx, piAddressVar))
{
Scierror(202, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), fname, i);
return 0;
}
}
if ( mx != my || nx != ny )
{
Scierror(999, _("%s: Wrong size for input arguments #%d and #%d: Same sizes expected.\n"), fname, 1, 2);
return 0;
}
GetRhsVar(3, TYPED_LIST_DATATYPE, &mt, &nt, <);
GetListRhsVar(3, 1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Str); /* m1 = 1, n1 = 8 ? a verifier */
if ( strcmp(Str[0], "cshep2d") != 0)
{
/* Free Str */
if (Str)
{
int li = 0;
while ( Str[li] != NULL)
{
FREE(Str[li]);
Str[li] = NULL;
li++;
};
FREE(Str);
Str = NULL;
}
Scierror(999, _("%s: Wrong type for input argument #%d: %s tlist expected.\n"), fname, 2, "cshep2d");
return 0;
}
/* Free Str */
if (Str)
{
int li = 0;
while ( Str[li] != NULL)
{
FREE(Str[li]);
Str[li] = NULL;
li++;
};
FREE(Str);
Str = NULL;
}
GetListRhsVar(3, 2, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &lxyz); /* m2 = n , n2 = 3 */
GetListRhsVar(3, 3, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m3, &n3, (int *)&Cell); /* m3 = nr, n3 = nr */
GetListRhsVar(3, 4, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m4, &n4, (int *)&Next); /* m4 = 1 , n4 = n */
GetListRhsVar(3, 5, MATRIX_OF_DOUBLE_DATATYPE, &m5, &n5, &lgrid); /* m5 = 1 , n5 = 4 */
GetListRhsVar(3, 6, MATRIX_OF_DOUBLE_DATATYPE, &m6, &n6, &lrmax); /* m6 = 1 , n6 = 1 */
GetListRhsVar(3, 7, MATRIX_OF_DOUBLE_DATATYPE, &m7, &n7, &lrw); /* m7 = 1 , n7 = n */
GetListRhsVar(3, 8, MATRIX_OF_DOUBLE_DATATYPE, &m8, &n8, &la); /* m8 = 9 , n8 = n */
cell = (int *)Cell.D;
next = (int *)Next.D;
xp = stk(lx);
yp = stk(ly);
np = mx * nx;
n = m2;
nr = m3;
xyz = stk(lxyz);
grid = stk(lgrid);
CreateVar(4, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lf);
f = stk(lf);
if ( Lhs > 1 )
{
CreateVar(5, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldfdx);
dfdx = stk(ldfdx);
CreateVar(6, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldfdy);
dfdy = stk(ldfdy);
}
if ( Lhs > 3 )
{
CreateVar(7, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldffdxx);
dffdxx = stk(ldffdxx);
CreateVar(8, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldffdxy);
dffdyy = stk(ldffdxy);
CreateVar(9, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldffdyy);
dffdxy = stk(ldffdyy);
}
switch ( Lhs )
{
case ( 1 ) :
for ( i = 0 ; i < np ; i++ )
/* DOUBLE PRECISION FUNCTION CS2VAL (PX,PY,N,X,Y,F,NR,
* LCELL,LNEXT,XMIN,YMIN,DX,DY,RMAX,RW,A)
*/
f[i] = C2F(cs2val)(&xp[i], &yp[i], &n, xyz, &xyz[n], &xyz[2 * n], &nr,
cell, next, grid, &grid[1], &grid[2], &grid[3],
stk(lrmax), stk(lrw), stk(la));
LhsVar(1) = 4;
break;
case ( 2 ) :
case ( 3 ) :
for ( i = 0 ; i < np ; i++ )
/* SUBROUTINE CS2GRD (PX,PY,N,X,Y,F,NR,LCELL,LNEXT,XMIN,
*. YMIN,DX,DY,RMAX,RW,A, C,CX,CY,IER)
*/
C2F(cs2grd) (&xp[i], &yp[i], &n, xyz, &xyz[n], &xyz[2 * n], &nr,
cell, next, grid, &grid[1], &grid[2], &grid[3],
stk(lrmax), stk(lrw), stk(la), &f[i], &dfdx[i], &dfdy[i], &ier);
LhsVar(1) = 4;
LhsVar(2) = 5;
LhsVar(3) = 6;
break;
case ( 4 ) :
case ( 5 ) :
case ( 6 ) :
for ( i = 0 ; i < np ; i++ )
{
/* SUBROUTINE CS2HES (PX,PY,N,X,Y,F,NR,LCELL,LNEXT,XMIN,
*. YMIN,DX,DY,RMAX,RW,A, C,CX,CY,CXX,CXY,CYY,IER)
*/
C2F(cs2hes) (&xp[i], &yp[i], &n, xyz, &xyz[n], &xyz[2 * n], &nr,
cell, next, grid, &grid[1], &grid[2], &grid[3],
stk(lrmax), stk(lrw), stk(la), &f[i], &dfdx[i], &dfdy[i],
&dffdxx[i], &dffdxy[i], &dffdyy[i], &ier);
}
LhsVar(1) = 4;
LhsVar(2) = 5;
LhsVar(3) = 6;
LhsVar(4) = 7;
LhsVar(5) = 8;
LhsVar(6) = 9;
break;
}
PutLhsVar();
return 0;
}
int sci_umf_lufact(char* fname, void* pvApiCtx)
{
SciErr sciErr;
int stat = 0;
SciSparse AA;
CcsSparse A;
int mA = 0; // rows
int nA = 0; // cols
int iNbItem = 0;
int* piNbItemRow = NULL;
int* piColPos = NULL;
double* pdblSpReal = NULL;
double* pdblSpImg = NULL;
/* umfpack stuff */
double* Control = NULL;
double* Info = NULL;
void* Symbolic = NULL;
void* Numeric = NULL;
int* piAddr1 = NULL;
int iComplex = 0;
int iType1 = 0;
/* Check numbers of input/output arguments */
CheckInputArgument(pvApiCtx, 1, 1);
CheckOutputArgument(pvApiCtx, 1, 1);
/* get A the sparse matrix to factorize */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* check if the first argument is a sparse matrix */
sciErr = getVarType(pvApiCtx, piAddr1, &iType1);
if (sciErr.iErr || iType1 != sci_sparse)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: A sparse matrix expected.\n"), fname, 1);
return 1;
}
if (isVarComplex(pvApiCtx, piAddr1))
{
iComplex = 1;
sciErr = getComplexSparseMatrix(pvApiCtx, piAddr1, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal, &pdblSpImg);
}
else
{
sciErr = getSparseMatrix(pvApiCtx, piAddr1, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal);
}
if (sciErr.iErr)
{
FREE(piNbItemRow);
FREE(piColPos);
FREE(pdblSpReal);
if (pdblSpImg)
{
FREE(pdblSpImg);
}
printError(&sciErr, 0);
return 1;
}
// fill struct sparse
AA.m = mA;
AA.n = nA;
AA.it = iComplex;
AA.nel = iNbItem;
AA.mnel = piNbItemRow;
AA.icol = piColPos;
AA.R = pdblSpReal;
AA.I = pdblSpImg;
if (nA <= 0 || mA <= 0)
{
FREE(piNbItemRow);
FREE(piColPos);
FREE(pdblSpReal);
if (pdblSpImg)
{
FREE(pdblSpImg);
}
Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, 1);
return 1;
}
SciSparseToCcsSparse(&AA, &A);
FREE(piNbItemRow);
FREE(piColPos);
FREE(pdblSpReal);
if (pdblSpImg)
{
FREE(pdblSpImg);
}
/* symbolic factorization */
if (A.it == 1)
{
stat = umfpack_zi_symbolic(nA, mA, A.p, A.irow, A.R, A.I, &Symbolic, Control, Info);
}
else
{
stat = umfpack_di_symbolic(nA, mA, A.p, A.irow, A.R, &Symbolic, Control, Info);
}
if (stat != UMFPACK_OK)
{
freeCcsSparse(A);
Scierror(999, _("%s: An error occurred: %s: %s\n"), fname, _("symbolic factorization"), UmfErrorMes(stat));
return 1;
}
/* numeric factorization */
if (A.it == 1)
{
stat = umfpack_zi_numeric(A.p, A.irow, A.R, A.I, Symbolic, &Numeric, Control, Info);
}
else
{
stat = umfpack_di_numeric(A.p, A.irow, A.R, Symbolic, &Numeric, Control, Info);
}
if (A.it == 1)
{
umfpack_zi_free_symbolic(&Symbolic);
}
else
{
umfpack_di_free_symbolic(&Symbolic);
}
if ( stat != UMFPACK_OK && stat != UMFPACK_WARNING_singular_matrix )
{
freeCcsSparse(A);
Scierror(999, _("%s: An error occurred: %s: %s\n"), fname, _("symbolic factorization"), UmfErrorMes(stat));
return 1;
}
if ( stat == UMFPACK_WARNING_singular_matrix && mA == nA )
{
if (getWarningMode())
{
Sciwarning("\n%s:%s\n", _("Warning"), _("The (square) matrix appears to be singular."));
}
}
/* add the pointer in the list ListNumeric */
if (! AddAdrToList(Numeric, A.it, &ListNumeric))
{
/* AddAdrToList return 0 if malloc have failed : as it is just
for storing 2 pointers this is unlikely to occurs but ... */
if (A.it == 1)
{
umfpack_zi_free_numeric(&Numeric);
}
else
{
umfpack_di_free_numeric(&Numeric);
}
freeCcsSparse(A);
Scierror(999, _("%s: An error occurred: %s\n"), fname, _("no place to store the LU pointer in ListNumeric."));
return 1;
}
freeCcsSparse(A);
/* create the scilab object to store the pointer onto the LU factors */
sciErr = createPointer(pvApiCtx, 2, Numeric);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* return the pointer */
AssignOutputVariable(pvApiCtx, 1) = 2;
ReturnArguments(pvApiCtx);
return 0;
}
int sci_gpuDotMult(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 "gpuDotMult : Bad type for input argument #1: Variables created with GPU functions expected.";
}
if (useCuda() && gpuPtrA->getGpuType() != GpuPointer::CudaType)
{
throw "gpuDotMult : Bad type for input argument #1: A Cuda pointer expected.";
}
if (useCuda() == false && gpuPtrA->getGpuType() != GpuPointer::OpenCLType)
{
throw "gpuDotMult : 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 "gpuDotMult: 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 "gpuDotMult: not implemented with OpenCL.";
}
#endif
}
}
else
{
throw "gpuDotMult : 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 "gpuDotMult : Bad type for input argument #2: Variables created with GPU functions expected.";
}
if (useCuda() && gpuPtrB->getGpuType() != GpuPointer::CudaType)
{
throw "gpuDotMult : Bad type for input argument #2: A Cuda pointer expected.";
}
if (useCuda() == false && gpuPtrB->getGpuType() != GpuPointer::OpenCLType)
{
throw "gpuDotMult : 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())
{
throw "gpuDotMult: not implemented with OpenCL.";
}
#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())
{
throw "gpuDotMult: not implemented with OpenCL.";
}
#endif
}
}
else
{
throw "gpuDotMult : Bad type for input argument #2: A GPU or CPU matrix expected.";
}
//performe operation.
if (gpuPtrA->getSize() == 1 || gpuPtrB->getSize() == 1)
{
gpuPtrC = *gpuPtrA * *gpuPtrB;
}
else if (gpuPtrA->getRows() == gpuPtrB->getRows() && gpuPtrA->getCols() == gpuPtrB->getCols())
{
#ifdef WITH_CUDA
if (useCuda())
{
gpuPtrC = cudaDotMult(dynamic_cast<PointerCuda*>(gpuPtrA), dynamic_cast<PointerCuda*>(gpuPtrB));
}
#endif
#ifdef WITH_OPENCL
if (!useCuda())
{
throw "gpuDotMult: not implemented with OpenCL.";
}
#endif
}
else
{
throw "gpuDotMult : Bad size for inputs arguments: Same sizes expected.";
}
// 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 (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 read_poly(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int i, j;
//variable info
int iRows = 0;
int iCols = 0;
int iVarLen = 0;
int* piAddr = NULL;
int* piNbCoef = NULL;
double** pdblReal = NULL;
double** pdblImg = NULL;
char* pstVarname = NULL;
//check input and output arguments
CheckInputArgument(pvApiCtx, 1, 1);
CheckOutputArgument(pvApiCtx, 1, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if (isVarComplex(pvApiCtx, piAddr) == FALSE)
{
//Error
return 0;
}
//get variable name length
sciErr = getPolyVariableName(pvApiCtx, piAddr, NULL, &iVarLen);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
//alloc buff to receive variable name
pstVarname = (char*)MALLOC(sizeof(char) * (iVarLen + 1));//1 for null termination
//get variable name
sciErr = getPolyVariableName(pvApiCtx, piAddr, pstVarname, &iVarLen);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
//First call: retrieve dimmension
sciErr = getComplexMatrixOfPoly(pvApiCtx, piAddr, &iRows, &iCols, NULL, NULL, NULL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
//alloc array of coefficient
piNbCoef = (int*)MALLOC(sizeof(int) * iRows * iCols);
//Second call: retrieve coefficient
sciErr = getComplexMatrixOfPoly(pvApiCtx, piAddr, &iRows, &iCols, piNbCoef, NULL, NULL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
//alloc arrays of data
pdblReal = (double**)MALLOC(sizeof(double*) * iRows * iCols);
pdblImg = (double**)MALLOC(sizeof(double*) * iRows * iCols);
for (i = 0 ; i < iRows * iCols ; i++)
{
pdblReal[i] = (double*)MALLOC(sizeof(double) * piNbCoef[i]);
pdblImg[i] = (double*)MALLOC(sizeof(double) * piNbCoef[i]);
}
//Third call: retrieve data
sciErr = getComplexMatrixOfPoly(pvApiCtx, piAddr, &iRows, &iCols, piNbCoef, pdblReal, pdblImg);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
//Do something with Data
//Invert polynomials in the matrix and invert coefficients
for (i = 0 ; i < (iRows * iCols) / 2 ; i++)
{
int iPos1 = iRows * iCols - 1 - i;
double* pdblSave = NULL;
int iNbCoefSave = 0;
//switch array of coefficient
pdblSave = pdblReal[i];
pdblReal[i] = pdblReal[iPos1];
pdblReal[iPos1] = pdblSave;
pdblSave = pdblImg[i];
pdblImg[i] = pdblImg[iPos1];
pdblImg[iPos1] = pdblSave;
//switch number of coefficient
iNbCoefSave = piNbCoef[i];
piNbCoef[i] = piNbCoef[iPos1];
piNbCoef[iPos1] = iNbCoefSave;
}
//switch coefficient
for (i = 0 ; i < iRows * iCols ; i++)
{
for (j = 0 ; j < piNbCoef[i] / 2 ; j++)
{
int iPos2 = piNbCoef[i] - 1 - j;
double dblVal = pdblReal[i][j];
pdblReal[i][j] = pdblReal[i][iPos2];
pdblReal[i][iPos2] = dblVal;
dblVal = pdblImg[i][j];
pdblImg[i][j] = pdblImg[i][iPos2];
pdblImg[i][iPos2] = dblVal;
}
}
sciErr = createComplexMatrixOfPoly(pvApiCtx, nbInputArgument(pvApiCtx) + 1, pstVarname, iRows, iCols, piNbCoef, pdblReal, pdblImg);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
//free OS memory
FREE(pstVarname);
FREE(piNbCoef);
for (i = 0 ; i < iRows * iCols ; i++)
{
FREE(pdblReal[i]);
FREE(pdblImg[i]);
}
FREE(pdblReal);
FREE(pdblImg);
//assign allocated variables to Lhs position
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
return 0;
}
/* ==================================================================== */
int sci_foo(char *fname, void* pvApiCtx, unsigned long fname_len)
{
// Error management variable
SciErr sciErr;
////////// Variables declaration //////////
int m1 = 0, n1 = 0;
int *piAddressVarOne = NULL;
double *matrixOfDouble = NULL;
double *newMatrixOfDouble = NULL;
int m2 = 0, n2 = 0;
int *piAddressVarTwo = NULL;
int *matrixOfBoolean = NULL;
int *newMatrixOfBoolean = NULL;
int i = 0;
////////// Check the number of input and output arguments //////////
/* --> [c, d] = foo(a, b) */
/* check that we have only 2 input arguments */
/* check that we have only 2 output argument */
CheckInputArgument(pvApiCtx, 2, 2) ;
CheckOutputArgument(pvApiCtx, 2, 2) ;
////////// Manage the first input argument (double) //////////
/* get Address of inputs */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
/* Check that the first input argument is a real matrix (and not complex) */
if ( !isDoubleType(pvApiCtx, piAddressVarOne) || isVarComplex(pvApiCtx, piAddressVarOne) )
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), fname, 1);
return 0;
}
/* get matrix */
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &m1, &n1, &matrixOfDouble);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
////////// Manage the second input argument (boolean) //////////
/* get Address of inputs */
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if ( !isBooleanType(pvApiCtx, piAddressVarTwo) )
{
Scierror(999, _("%s: Wrong type for input argument #%d: A boolean matrix expected.\n"), fname, 2);
return 0;
}
/* get matrix */
sciErr = getMatrixOfBoolean(pvApiCtx, piAddressVarTwo, &m2, &n2, &matrixOfBoolean);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
////////// Check the consistency of the two input arguments //////////
if ((m1 != m2) | - (n1 != n2))
{
Scierror(999, _("%s: Wrong size for input arguments: Same size expected.\n"), fname, 1);
return 0;
}
newMatrixOfDouble = (double*)malloc(sizeof(double) * m1 * n1);
////////// Application code //////////
// Could be replaced by a call to a library
for (i = 0; i < m1 * n1; i++)
{
/* For each element of the matrix, multiply by 2 */
newMatrixOfDouble[i] = matrixOfDouble[i] * 2;
}
newMatrixOfBoolean = (int*)malloc(sizeof(double) * m2 * n2);
for (i = 0; i < m2 * n2; i++)
{
/* For each element of the matrix, invert the value */
newMatrixOfBoolean[i] = matrixOfBoolean[i] == TRUE ? FALSE : TRUE;
}
////////// Create the output arguments //////////
/* Create the matrix as return of the function */
sciErr = createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, m1, n1, newMatrixOfDouble);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
/* Create the matrix as return of the function */
sciErr = createMatrixOfBoolean(pvApiCtx, nbInputArgument(pvApiCtx) + 2, m2, n2, newMatrixOfBoolean);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
////////// Return the output arguments to the Scilab engine //////////
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
AssignOutputVariable(pvApiCtx, 2) = nbInputArgument(pvApiCtx) + 2;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int intsplin(char *fname,unsigned long fname_len)
{
int minrhs = 2, maxrhs = 4, minlhs = 1, maxlhs = 1;
int mx = 0, nx = 0, lx = 0, my = 0, ny = 0, ly = 0, mc = 0, nc = 0, lc = 0, n = 0, spline_type = 0;
int *str_spline_type = NULL, ns = 0;
int ld = 0, i = 0;
int mwk1 = 0, nwk1 = 0, lwk1 = 0, mwk2 = 0, nwk2 = 0, lwk2 = 0, mwk3 = 0;
int nwk3 = 0, lwk3 = 0, mwk4 = 0, nwk4 = 0, lwk4 = 0;
double *x = NULL, *y = NULL, *d = NULL, *c = NULL;
CheckRhs(minrhs, maxrhs);
CheckLhs(minlhs, maxlhs);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &my, &ny, &ly);
for (i = 1; i <= minrhs; i++)
{
SciErr sciErr;
int *piAddressVar = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 0;
}
if (isVarComplex(pvApiCtx, piAddressVar))
{
Scierror(202, _("%s: Wrong type for argument %d: Real matrix expected.\n"), fname, i);
return 0;
}
}
if ( mx != my || nx != ny || (mx != 1 && nx != 1) )
{
Scierror(999,_("%s: Wrong size for input arguments #%d and #%d: Vector of same size expected.\n"), fname, 1, 2);
return 0;
}
n = mx * nx; /* number of interpolation points */
if ( n < 2 )
{
Scierror(999,_("%s: Wrong size for input argument #%d: Must be %s.\n"), fname,1,">= 2");
return 0;
}
x = stk(lx);
y = stk(ly);
if (! good_order(x, n)) /* verify strict increasing abscissae */
{
Scierror(999,_("%s: Wrong value for input argument #%d: Not (strictly) increasing or +-inf detected.\n"), fname,1);
return 0;
}
if ( Rhs >= 3 ) /* get the spline type */
{
GetRhsScalarString(3, &ns, &str_spline_type);
spline_type = get_type(SplineTable, NB_SPLINE_TYPE, str_spline_type, ns);
if ( spline_type == UNDEFINED )
{
Scierror(999,_("%s: Wrong values for input argument #%d: Unknown '%s' type.\n"),fname,3,"spline");
return 0;
};
}
else
{
spline_type = NOT_A_KNOT;
}
if ( spline_type == CLAMPED ) /* get arg 4 which contains the end point slopes */
{
if ( Rhs != 4 )
{
Scierror(999,_("%s: For a clamped spline, you must give the endpoint slopes.\n"),fname);
return 0;
}
GetRhsVar(4,MATRIX_OF_DOUBLE_DATATYPE, &mc, &nc, &lc);
if ( mc*nc != 2 )
{
Scierror(999,_("%s: Wrong size for input argument #%d: Endpoint slopes.\n"),fname,4);
return 0;
}
c = stk(lc);
}
else if ( Rhs == 4 )
{
Scierror(999,_("%s: Wrong number of input argument(s).\n"),fname);
return 0;
}
/* verify y(1) = y(n) for periodic splines */
if ( (spline_type == PERIODIC || spline_type == FAST_PERIODIC) && y[0] != y[n-1] )
{
Scierror(999,_("%s: Wrong value for periodic spline %s: Must be equal to %s.\n"),fname,"y(1)","y(n)");
return(0);
};
CreateVar(Rhs+1,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ld); /* memory for d (only argument returned) */
d = stk(ld);
switch(spline_type)
{
case(FAST) : case(FAST_PERIODIC) :
nwk1 = 1;
C2F(derivd) (x, y, d, &n, &nwk1, &spline_type);
break;
case(MONOTONE) :
nwk1 = 1;
C2F(dpchim) (&n, x, y, d, &nwk1);
break;
case(NOT_A_KNOT) : case(NATURAL) : case(CLAMPED) : case(PERIODIC) :
/* (the wk4 work array is used only in the periodic case) */
mwk1 = n; nwk1 = 1; mwk2 = n-1; nwk2 = 1; mwk3 = n-1; nwk3 = 1; mwk4 = n-1; nwk4 = 1;
CreateVar(Rhs+2,MATRIX_OF_DOUBLE_DATATYPE, &mwk1, &nwk1, &lwk1);
CreateVar(Rhs+3,MATRIX_OF_DOUBLE_DATATYPE, &mwk2, &nwk2, &lwk2);
CreateVar(Rhs+4,MATRIX_OF_DOUBLE_DATATYPE, &mwk3, &nwk3, &lwk3);
lwk4 = lwk1;
if (spline_type == CLAMPED)
{ d[0] = c[0]; d[n-1] = c[1]; };
if (spline_type == PERIODIC)
{
CreateVar(Rhs+5,MATRIX_OF_DOUBLE_DATATYPE, &mwk4, &nwk4, &lwk4);
}
C2F(splinecub) (x, y, d, &n, &spline_type, stk(lwk1), stk(lwk2), stk(lwk3), stk(lwk4));
break;
}
LhsVar(1) = Rhs+1;
PutLhsVar();
return 0;
}
//both basic and advanced loader use this code
static int commonCodePart2()
{
//get input 3: lower bounds of variables
if(getFixedSizeDoubleMatrixFromScilab(3,1,numVars,&lowerBounds))
{
cleanupBeforeExit();
return 1;
}
//get input 4: upper bounds of variables
if(getFixedSizeDoubleMatrixFromScilab(4,1,numVars,&upperBounds))
{
cleanupBeforeExit();
return 1;
}
//get input 5: coefficients of variables in objective function to be minimized
if(getFixedSizeDoubleMatrixFromScilab(5,1,numVars,&objective))
{
cleanupBeforeExit();
return 1;
}
//get input 6: array that specifies wether a variable is constrained to be an integer
sciErr = getVarAddressFromPosition(pvApiCtx, 6, &varAddress);
if (sciErr.iErr)
{
printError(&sciErr, 0);
cleanupBeforeExit();return 1;
}
if ( !isBooleanType(pvApiCtx, varAddress) )
{
Scierror(999, "Wrong type for input argument #6: A matrix of booleans is expected.\n");
cleanupBeforeExit();return 1;
}
sciErr = getMatrixOfBoolean(pvApiCtx, varAddress, &inputMatrixRows, &inputMatrixCols, &isIntVarBool);
if (sciErr.iErr)
{
printError(&sciErr, 0);
cleanupBeforeExit();return 1;
}
if(inputMatrixRows!=1 || inputMatrixCols!=numVars)
{
Scierror(999, "Wrong type for input argument #6: Incorrectly sized matrix.\n");
cleanupBeforeExit();return 1;
}
for(colIter=0;colIter<numVars;colIter++)
{
if(isIntVarBool[colIter])
isIntVar[colIter]=TRUE;
else
isIntVar[colIter]=FALSE;
}
//get input 7: wether to minimize or maximize objective
sciErr = getVarAddressFromPosition(pvApiCtx, 7, &varAddress);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if ( !isDoubleType(pvApiCtx,varAddress) || isVarComplex(pvApiCtx,varAddress) )
{
Scierror(999, "Wrong type for input argument #7: Either 1 (sym_minimize) or -1 (sym_maximize) is expected.\n");
return 1;
}
iRet = getScalarDouble(pvApiCtx, varAddress, &objSense);
if(iRet || (objSense!=-1 && objSense!=1))
{
Scierror(999, "Wrong type for input argument #7: Either 1 (sym_minimize) or -1 (sym_maximize) is expected.\n");
return 1;
}
iRet=sym_set_obj_sense(global_sym_env,objSense);
if(iRet==FUNCTION_TERMINATED_ABNORMALLY)
{
Scierror(999, "An error occured.\n");
return 1;
}
//get input 9: constraint lower bound
if(getFixedSizeDoubleMatrixFromScilab(9,numConstr,1,&conLower))
{
cleanupBeforeExit();
return 1;
}
//get input 10: constraint upper bound
if(getFixedSizeDoubleMatrixFromScilab(10,numConstr,1,&conUpper))
{
cleanupBeforeExit();
return 1;
}
//deduce type of constraint
for(rowIter=0;rowIter<numConstr;rowIter++)
{
if(conLower[rowIter]>conUpper[rowIter])
{
Scierror(999, "Error: the lower bound of constraint %d is more than its upper bound.\n",rowIter);
cleanupBeforeExit();
return 1;
}
if(conLower[rowIter]==(-INFINITY) && conUpper[rowIter]==INFINITY){
conType[rowIter]='N';
conRange[rowIter]=0;
conRHS[rowIter]=0;
}else if(conLower[rowIter]==(-INFINITY)){
conType[rowIter]='L';
conRange[rowIter]=0;
conRHS[rowIter]=conUpper[rowIter];
}else if(conUpper[rowIter]==INFINITY){
conType[rowIter]='G';
conRange[rowIter]=0;
conRHS[rowIter]=conLower[rowIter];
}else if(conUpper[rowIter]==conLower[rowIter]){
conType[rowIter]='E';
conRange[rowIter]=0;
conRHS[rowIter]=conLower[rowIter];
}else{
conType[rowIter]='R';
conRange[rowIter]=conUpper[rowIter]-conLower[rowIter];
conRHS[rowIter]=conUpper[rowIter];
}
}
/*
//for debug: show all data
sciprint("Vars: %d Constr: %d ObjType: %lf\n",numVars,numConstr,objSense);
for(colIter=0;colIter<numVars;colIter++)
sciprint("Var %d: upper: %lf lower: %lf isInt: %d ObjCoeff: %lf\n",colIter,lowerBounds[colIter],upperBounds[colIter],isIntVar[colIter],objective[colIter]);
for(rowIter=0;rowIter<numConstr;rowIter++)
sciprint("Constr %d: type: %c lower: %lf upper: %lf range: %lf\n",rowIter,conType[rowIter],conLower[rowIter],conRange[rowIter]);
*/
//call problem loader
sym_explicit_load_problem(global_sym_env,numVars,numConstr,conMatrixColStart,conMatrixRowIndex,conMatrix,lowerBounds,upperBounds,isIntVar,objective,NULL,conType,conRHS,conRange,TRUE);
sciprint("Problem loaded into environment.\n");
//code to give output
cleanupBeforeExit();
return 0;
}
//advanced problem loader, expects sparse matrix. For use with larger problems (>10 vars)
int sci_sym_loadProblem(char *fname)
{
int retVal,nonZeros,*itemsPerRow,*colIndex,matrixIter,newPos,*oldRowIndex,*colStartCopy;
double *data;
if(commonCodePart1())
return 1;
//get input 8: matrix of constraint equation coefficients
sciErr = getVarAddressFromPosition(pvApiCtx, 8, &varAddress);
if (sciErr.iErr)
{
printError(&sciErr, 0);
cleanupBeforeExit();return 1;
}
if ( !isSparseType(pvApiCtx,varAddress) || isVarComplex(pvApiCtx,varAddress) )
{
Scierror(999, "Wrong type for input argument #8: A sparse matrix of doubles is expected.\n");
cleanupBeforeExit();return 1;
}
sciErr = getSparseMatrix(pvApiCtx,varAddress,&inputMatrixRows,&inputMatrixCols,&nonZeros,&itemsPerRow,&colIndex,&data);
if (sciErr.iErr)
{
printError(&sciErr, 0);
cleanupBeforeExit();return 1;
}
if(inputMatrixRows!=numConstr || inputMatrixCols!=numVars)
{
Scierror(999, "Wrong type for input argument #8: Incorrectly sized matrix.\n");
cleanupBeforeExit();return 1;
}
//convert SciLab format sparse matrix into the format required by Symphony
conMatrix=new double[nonZeros]; //matrix contents
conMatrixColStart=new int[numVars+1]; //where each column of the matrix starts
conMatrixRowIndex=new int[nonZeros]; //row number of each element
oldRowIndex=new int[nonZeros]; //row number in old matrix
colStartCopy=new int[numVars+1]; //temporary copy of conMatrixColStart
for(rowIter=matrixIter=0;rowIter<numConstr;rowIter++) //assign row number to each element in old matrix
for(colIter=0;colIter<itemsPerRow[rowIter];colIter++,matrixIter++)
oldRowIndex[matrixIter]=rowIter;
for(colIter=0;colIter<=numVars;colIter++) //initialize to 0
conMatrixColStart[colIter]=0;
for(matrixIter=0;matrixIter<nonZeros;matrixIter++) //get number of elements in each column
conMatrixColStart[colIndex[matrixIter]]++;
for(colIter=1;colIter<=numVars;colIter++) //perfrom cumulative addition to get final data about where each column starts
{
conMatrixColStart[colIter]+=conMatrixColStart[colIter-1];
colStartCopy[colIter]=conMatrixColStart[colIter];
}
colStartCopy[0]=0;
for(matrixIter=0;matrixIter<nonZeros;matrixIter++) //move data from old matrix to new matrix
{
newPos=colStartCopy[colIndex[matrixIter]-1]++; //calculate its position in the new matrix
conMatrix[newPos]=data[matrixIter]; //move the data
conMatrixRowIndex[newPos]=oldRowIndex[matrixIter]; //assign it its row number
}
retVal=commonCodePart2();
//cleanup some more allocd memory
if(conMatrix) delete[] conMatrix;
if(oldRowIndex) delete[] oldRowIndex;
if(colStartCopy) delete[] colStartCopy;
return retVal;
}
int sci_umfpack(char* fname, void* pvApiCtx)
{
SciErr sciErr;
int mb = 0;
int nb = 0;
int i = 0;
int num_A = 0;
int num_b = 0;
int mW = 0;
int Case = 0;
int stat = 0;
SciSparse AA;
CcsSparse A;
int* piAddrA = NULL;
int* piAddr2 = NULL;
int* piAddrB = NULL;
double* pdblBR = NULL;
double* pdblBI = NULL;
double* pdblXR = NULL;
double* pdblXI = NULL;
int iComplex = 0;
int freepdblBI = 0;
int mA = 0; // rows
int nA = 0; // cols
int iNbItem = 0;
int* piNbItemRow = NULL;
int* piColPos = NULL;
double* pdblSpReal = NULL;
double* pdblSpImg = NULL;
/* umfpack stuff */
double Info[UMFPACK_INFO];
double* Control = NULL;
void* Symbolic = NULL;
void* Numeric = NULL;
int* Wi = NULL;
double* W = NULL;
char* pStr = NULL;
int iType2 = 0;
int iTypeA = 0;
int iTypeB = 0;
/* Check numbers of input/output arguments */
CheckInputArgument(pvApiCtx, 3, 3);
CheckOutputArgument(pvApiCtx, 1, 1);
/* First get arg #2 : a string of length 1 */
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddr2, &iType2);
if (sciErr.iErr || iType2 != sci_strings)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, 2);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddr2, &pStr))
{
return 1;
}
/* select Case 1 or 2 depending (of the first char of) the string ... */
if (pStr[0] == '\\') // compare pStr[0] with '\'
{
Case = 1;
num_A = 1;
num_b = 3;
}
else if (pStr[0] == '/')
{
Case = 2;
num_A = 3;
num_b = 1;
}
else
{
Scierror(999, _("%s: Wrong input argument #%d: '%s' or '%s' expected.\n"), fname, 2, "\\", "/");
FREE(pStr);
return 1;
}
FREE(pStr);
/* get A */
sciErr = getVarAddressFromPosition(pvApiCtx, num_A, &piAddrA);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddrA, &iTypeA);
if (sciErr.iErr || iTypeA != sci_sparse)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: A sparse matrix expected.\n"), fname, 1);
return 1;
}
if (isVarComplex(pvApiCtx, piAddrA))
{
AA.it = 1;
iComplex = 1;
sciErr = getComplexSparseMatrix(pvApiCtx, piAddrA, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal, &pdblSpImg);
}
else
{
AA.it = 0;
sciErr = getSparseMatrix(pvApiCtx, piAddrA, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// fill struct sparse
AA.m = mA;
AA.n = nA;
AA.nel = iNbItem;
AA.mnel = piNbItemRow;
AA.icol = piColPos;
AA.R = pdblSpReal;
AA.I = pdblSpImg;
if ( mA != nA || mA < 1 )
{
Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, num_A);
return 1;
}
/* get B*/
sciErr = getVarAddressFromPosition(pvApiCtx, num_b, &piAddrB);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddrB, &iTypeB);
if (sciErr.iErr || iTypeB != sci_matrix)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), fname, 3);
return 1;
}
if (isVarComplex(pvApiCtx, piAddrB))
{
iComplex = 1;
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddrB, &mb, &nb, &pdblBR, &pdblBI);
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddrB, &mb, &nb, &pdblBR);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if ( (Case == 1 && ( mb != mA || nb < 1 )) || (Case == 2 && ( nb != mA || mb < 1 )) )
{
Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, num_b);
return 1;
}
SciSparseToCcsSparse(&AA, &A);
/* allocate memory for the solution x */
if (iComplex)
{
sciErr = allocComplexMatrixOfDouble(pvApiCtx, 4, mb, nb, &pdblXR, &pdblXI);
}
else
{
sciErr = allocMatrixOfDouble(pvApiCtx, 4, mb, nb, &pdblXR);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
freeCcsSparse(A);
return 1;
}
if (A.it == 1)
{
mW = 10 * mA;
}
else
{
mW = 5 * mA;
}
if (A.it == 1 && pdblBI == NULL)
{
int iSize = mb * nb * sizeof(double);
pdblBI = (double*)MALLOC(iSize);
memset(pdblBI, 0x00, iSize);
freepdblBI = 1;
}
/* Now calling umfpack routines */
if (A.it == 1)
{
stat = umfpack_zi_symbolic(mA, nA, A.p, A.irow, A.R, A.I, &Symbolic, Control, Info);
}
else
{
stat = umfpack_di_symbolic(mA, nA, A.p, A.irow, A.R, &Symbolic, Control, Info);
}
if ( stat != UMFPACK_OK )
{
Scierror(999, _("%s: An error occurred: %s: %s\n"), fname, _("symbolic factorization"), UmfErrorMes(stat));
freeCcsSparse(A);
if (freepdblBI)
{
FREE(pdblBI);
}
return 1;
}
if (A.it == 1)
{
stat = umfpack_zi_numeric(A.p, A.irow, A.R, A.I, Symbolic, &Numeric, Control, Info);
}
else
{
stat = umfpack_di_numeric(A.p, A.irow, A.R, Symbolic, &Numeric, Control, Info);
}
if (A.it == 1)
{
umfpack_zi_free_symbolic(&Symbolic);
}
else
{
umfpack_di_free_symbolic(&Symbolic);
}
if ( stat != UMFPACK_OK )
{
Scierror(999, _("%s: An error occurred: %s: %s\n"), fname, _("numeric factorization"), UmfErrorMes(stat));
if (A.it == 1)
{
umfpack_zi_free_numeric(&Numeric);
}
else
{
umfpack_di_free_numeric(&Numeric);
}
freeCcsSparse(A);
if (freepdblBI)
{
FREE(pdblBI);
}
return 1;
}
/* allocate memory for umfpack_di_wsolve usage or umfpack_zi_wsolve usage*/
Wi = (int*)MALLOC(mA * sizeof(int));
W = (double*)MALLOC(mW * sizeof(double));
if ( Case == 1 ) /* x = A\b <=> Ax = b */
{
if (A.it == 0)
{
for ( i = 0 ; i < nb ; i++ )
{
umfpack_di_wsolve(UMFPACK_A, A.p, A.irow, A.R, &pdblXR[i * mb], &pdblBR[i * mb],
Numeric, Control, Info, Wi, W);
}
if (isVarComplex(pvApiCtx, piAddrB))
{
for ( i = 0 ; i < nb ; i++ )
{
umfpack_di_wsolve(UMFPACK_A, A.p, A.irow, A.R, &pdblXI[i * mb], &pdblBI[i * mb],
Numeric, Control, Info, Wi, W);
}
}
}
else /* A.it == 1 */
{
for ( i = 0 ; i < nb ; i++ )
{
umfpack_zi_wsolve(UMFPACK_A, A.p, A.irow, A.R, A.I, &pdblXR[i * mb], &pdblXI[i * mb],
&pdblBR[i * mb], &pdblBI[i * mb], Numeric, Control, Info, Wi, W);
}
}
}
else /* Case == 2, x = b/A <=> x A = b <=> A.'x.' = b.' */
{
if (A.it == 0)
{
TransposeMatrix(pdblBR, mb, nb, pdblXR); /* put b in x (with transposition) */
for ( i = 0 ; i < mb ; i++ )
{
umfpack_di_wsolve(UMFPACK_At, A.p, A.irow, A.R, &pdblBR[i * nb], &pdblXR[i * nb],
Numeric, Control, Info, Wi, W); /* the solutions are in br */
}
TransposeMatrix(pdblBR, nb, mb, pdblXR); /* put now br in xr with transposition */
if (isVarComplex(pvApiCtx, piAddrB))
{
TransposeMatrix(pdblBI, mb, nb, pdblXI); /* put b in x (with transposition) */
for ( i = 0 ; i < mb ; i++ )
{
umfpack_di_wsolve(UMFPACK_At, A.p, A.irow, A.R, &pdblBI[i * nb], &pdblXI[i * nb],
Numeric, Control, Info, Wi, W); /* the solutions are in bi */
}
TransposeMatrix(pdblBI, nb, mb, pdblXI); /* put now bi in xi with transposition */
}
}
else /* A.it==1 */
{
TransposeMatrix(pdblBR, mb, nb, pdblXR);
TransposeMatrix(pdblBI, mb, nb, pdblXI);
for ( i = 0 ; i < mb ; i++ )
{
umfpack_zi_wsolve(UMFPACK_Aat, A.p, A.irow, A.R, A.I, &pdblBR[i * nb], &pdblBI[i * nb],
&pdblXR[i * nb], &pdblXI[i * nb], Numeric, Control, Info, Wi, W);
}
TransposeMatrix(pdblBR, nb, mb, pdblXR);
TransposeMatrix(pdblBI, nb, mb, pdblXI);
}
}
if (A.it == 1)
{
umfpack_zi_free_numeric(&Numeric);
}
else
{
umfpack_di_free_numeric(&Numeric);
}
if (piNbItemRow != NULL)
{
FREE(piNbItemRow);
}
if (piColPos != NULL)
{
FREE(piColPos);
}
if (pdblSpReal != NULL)
{
FREE(pdblSpReal);
}
if (pdblSpImg != NULL)
{
FREE(pdblSpImg);
}
FREE(W);
FREE(Wi);
if (freepdblBI)
{
FREE(pdblBI);
}
freeCcsSparse(A);
AssignOutputVariable(pvApiCtx, 1) = 4;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_fprintfMat(char *fname,unsigned long fname_len)
{
SciErr sciErr;
int *piAddressVarOne = NULL;
int m1 = 0, n1 = 0;
int iType1 = 0;
int *piAddressVarTwo = NULL;
int m2 = 0, n2 = 0;
int iType2 = 0;
fprintfMatError ierr = FPRINTFMAT_ERROR;
char *filename = NULL;
char *expandedFilename = NULL;
char **textAdded = NULL;
char *Format = NULL;
double *dValues = NULL;
char *separator = NULL;
int m4n4 = 0;
int i = 0;
Nbvars = 0;
CheckRhs(1,5);
CheckLhs(1,1);
if (Rhs >= 3)
{
int *piAddressVarThree = NULL;
int iType3 = 0;
int m3 = 0, n3 = 0;
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;
}
sciErr = getVarType(pvApiCtx, piAddressVarThree, &iType3);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 3);
return 0;
}
if (iType3 != sci_strings)
{
Scierror(999,_("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 3);
return 0;
}
sciErr = getVarDimension(pvApiCtx, piAddressVarThree, &m3, &n3);
if ( (m3 != n3) && (n3 != 1) )
{
Scierror(999,_("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 3);
return 0;
}
if (getAllocatedSingleString(pvApiCtx, piAddressVarThree, &Format))
{
Scierror(999,_("%s: Memory allocation error.\n"), fname);
return 0;
}
}
else
{
Format = strdup(DEFAULT_FPRINTFMAT_FORMAT);
}
if ( Rhs >= 4 )
{
int *piAddressVarFour = NULL;
int *lengthStrings = NULL;
int iType4 = 0;
int m4 = 0, n4 = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddressVarFour);
if(sciErr.iErr)
{
if (Format) {FREE(Format); Format = NULL;}
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 4);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarFour, &iType4);
if(sciErr.iErr)
{
if (Format) {FREE(Format); Format = NULL;}
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 4);
return 0;
}
if (iType4 != sci_strings)
{
if (Format) {FREE(Format); Format = NULL;}
Scierror(999,_("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 4);
return 0;
}
sciErr = getVarDimension(pvApiCtx, piAddressVarFour, &m4, &n4);
if(sciErr.iErr)
{
if (Format) {FREE(Format); Format = NULL;}
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 4);
return 0;
}
if (! ((m4 == 1) || (n4 == 1)))
{
if (Format) {FREE(Format); Format = NULL;}
Scierror(999,_("%s: Wrong size for input argument #%d.\n"), fname, 4);
return 0;
}
lengthStrings = (int*)MALLOC(sizeof(int) * (m4 * n4));
if (lengthStrings == NULL)
{
if (Format) {FREE(Format); Format = NULL;}
Scierror(999,_("%s: Memory allocation error.\n"),fname);
return 0;
}
// get lengthStrings value
sciErr = getMatrixOfString(pvApiCtx, piAddressVarFour, &m4, &n4, lengthStrings, NULL);
if(sciErr.iErr)
{
if (Format) {FREE(Format); Format = NULL;}
if (lengthStrings) {FREE(lengthStrings); lengthStrings = NULL;}
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 4);
return 0;
}
textAdded = (char**)MALLOC(sizeof(char*) * (m4 * n4));
if (textAdded == NULL)
{
if (Format) {FREE(Format); Format = NULL;}
if (lengthStrings) {FREE(lengthStrings); lengthStrings = NULL;}
Scierror(999,_("%s: Memory allocation error.\n"),fname);
return 0;
}
for (i = 0; i < (m4 * n4); i++)
{
textAdded[i] = (char*)MALLOC(sizeof(char) * (lengthStrings[i] + 1));
if (textAdded[i] == NULL)
{
freeArrayOfString(textAdded, m4 * n4);
if (Format) {FREE(Format); Format = NULL;}
if (lengthStrings) {FREE(lengthStrings); lengthStrings = NULL;}
Scierror(999,_("%s: Memory allocation error.\n"),fname);
return 0;
}
}
// get textAdded
sciErr = getMatrixOfString(pvApiCtx, piAddressVarFour, &m4, &n4, lengthStrings, textAdded);
if (lengthStrings) {FREE(lengthStrings); lengthStrings = NULL;}
if(sciErr.iErr)
{
freeArrayOfString(textAdded, m4 * n4);
if (Format) {FREE(Format); Format = NULL;}
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 4);
return 0;
}
m4n4 = m4 * n4;
}
if (Rhs > 4)
{
int *piAddressVarFive = NULL;
int iType5 = 0;
int m5 = 0, n5 = 0;
sciErr = getVarAddressFromPosition(pvApiCtx, 5, &piAddressVarFive);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 5);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarFive, &iType5);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 5);
return 0;
}
if (iType5 != sci_strings)
{
Scierror(999,_("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 5);
return 0;
}
sciErr = getVarDimension(pvApiCtx, piAddressVarFive, &m5, &n5);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 5);
return 0;
}
if ( (m5 != n5) && (n5 != 1) )
{
Scierror(999,_("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 5);
return 0;
}
if (getAllocatedSingleString(pvApiCtx, piAddressVarFive, &separator))
{
Scierror(999,_("%s: Memory allocation error.\n"), fname);
return 0;
}
}
else
{
separator = strdup(DEFAULT_FPRINTFMAT_SEPARATOR);
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if(sciErr.iErr)
{
if (textAdded) freeArrayOfString(textAdded, m4n4);
if (Format) {FREE(Format); Format = NULL;}
if (separator){FREE(separator); separator = NULL;}
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarTwo, &iType2);
if(sciErr.iErr)
{
if (textAdded) freeArrayOfString(textAdded, m4n4);
if (Format) {FREE(Format); Format = NULL;}
if (separator){FREE(separator); separator = NULL;}
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 0;
}
if (iType2 != sci_matrix)
{
if (textAdded) freeArrayOfString(textAdded, m4n4);
if (Format) {FREE(Format); Format = NULL;}
if (separator){FREE(separator); separator = NULL;}
Scierror(999,_("%s: Wrong type for input argument #%d: Matrix of floating point numbers expected.\n"), fname, 2);
return 0;
}
if (isVarComplex(pvApiCtx, piAddressVarTwo))
{
if (textAdded) freeArrayOfString(textAdded, m4n4);
if (Format) {FREE(Format); Format = NULL;}
if (separator){FREE(separator); separator = NULL;}
Scierror(999,_("%s: Wrong type for input argument #%d: Real values expected.\n"), fname, 2);
return 0;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo, &m2, &n2, &dValues);
if(sciErr.iErr)
{
if (textAdded) freeArrayOfString(textAdded, m4n4);
if (Format) {FREE(Format); Format = NULL;}
if (separator){FREE(separator); separator = NULL;}
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if(sciErr.iErr)
{
if (textAdded) freeArrayOfString(textAdded, m4n4);
if (Format) {FREE(Format); Format = NULL;}
if (separator){FREE(separator); separator = NULL;}
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)
{
if (textAdded) freeArrayOfString(textAdded, m4n4);
if (Format) {FREE(Format); Format = NULL;}
if (separator){FREE(separator); separator = NULL;}
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (iType1 != sci_strings)
{
if (textAdded) freeArrayOfString(textAdded, m4n4);
if (Format) {FREE(Format); Format = NULL;}
if (separator){FREE(separator); separator = NULL;}
Scierror(999,_("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 1);
return 0;
}
sciErr = getVarDimension(pvApiCtx, piAddressVarOne, &m1, &n1);
if ( (m1 != n1) && (n1 != 1) )
{
if (textAdded) freeArrayOfString(textAdded, m4n4);
if (Format) {FREE(Format); Format = NULL;}
if (separator){FREE(separator); separator = NULL;}
Scierror(999,_("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 1);
return 0;
}
if (getAllocatedSingleString(pvApiCtx, piAddressVarOne, &filename))
{
if (textAdded) freeArrayOfString(textAdded, m4n4);
if (Format) {FREE(Format); Format = NULL;}
if (separator){FREE(separator); separator = NULL;}
Scierror(999,_("%s: Memory allocation error.\n"), fname);
return 0;
}
expandedFilename = expandPathVariable(filename);
ierr = fprintfMat(expandedFilename, Format, separator, dValues, m2, n2,textAdded, m4n4);
if (expandedFilename) {FREE(expandedFilename); expandedFilename = NULL;}
if (textAdded) freeArrayOfString(textAdded, m4n4);
if (Format) {FREE(Format); Format = NULL;}
if (separator){FREE(separator); separator = NULL;}
switch(ierr)
{
case FPRINTFMAT_NO_ERROR:
{
LhsVar(1) = 0;
if (filename) {FREE(filename); filename = NULL;}
PutLhsVar();
}
break;
case FPRINTFMAT_FOPEN_ERROR:
{
Scierror(999,_("%s: can not open file %s.\n"), fname, filename);
}
break;
case FPRINTMAT_FORMAT_ERROR:
{
Scierror(999,_("%s: Invalid format.\n"), fname);
}
break;
default:
case FPRINTFMAT_ERROR:
{
Scierror(999,_("%s: error.\n"), fname);
}
break;
}
if (filename) {FREE(filename); filename = NULL;}
return 0;
}
/*--------------------------------------------------------------------------*/
int intinterp3d(char *fname, unsigned long fname_len)
{
/*
* [f [, dfdx, dfdy, dfdz]] = interp3d(xp, yp, zp, tlcoef [,outmode])
*/
int minrhs = 4, maxrhs = 5, minlhs = 1, maxlhs = 4;
int mxp = 0, nxp = 0, lxp = 0, myp = 0, nyp = 0, lyp = 0, mzp = 0, nzp = 0, lzp = 0, mt = 0, nt = 0, lt = 0, np = 0;
int one = 1, kx = 0, ky = 0, kz = 0;
int nx = 0, ny = 0, nz = 0, nxyz = 0, mtx = 0, mty = 0, mtz = 0, m = 0, n = 0;
int ltx = 0, lty = 0, ltz = 0, lbcoef = 0, mwork = 0, lwork = 0, lfp = 0;
int lxyzminmax = 0, nsix = 0, outmode = 0, ns = 0, *str_outmode = NULL;
int m1 = 0, n1 = 0, ldfpdx = 0, ldfpdy = 0, ldfpdz = 0;
double *fp = NULL, *xp = NULL, *yp = NULL, *zp = NULL, *dfpdx = NULL, *dfpdy = NULL, *dfpdz = NULL;
double *xyzminmax = 0, xmin = 0, xmax = 0, ymin = 0, ymax = 0, zmin = 0, zmax = 0;
SciIntMat Order;
int *order = NULL;
char **Str = NULL;
int i = 0;
CheckRhs(minrhs, maxrhs);
CheckLhs(minlhs, maxlhs);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &lxp);
xp = stk(lxp);
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &myp, &nyp, &lyp);
yp = stk(lyp);
GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &mzp, &nzp, &lzp);
zp = stk(lzp);
for (i = 1; i <= minrhs - 1; i++)
{
SciErr sciErr;
int *piAddressVar = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 0;
}
if (isVarComplex(pvApiCtx, piAddressVar))
{
Scierror(202, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), fname, i);
return 0;
}
}
if ( mxp != myp || nxp != nyp || mxp != mzp || nxp != nzp)
{
Scierror(999,_("%s: Wrong size for input arguments #%d, #%d and #%d: Same sizes expected.\n"),fname,1,2,3);
return 0;
}
np = mxp * nxp;
GetRhsVar(4, TYPED_LIST_DATATYPE,&mt, &nt, <);
GetListRhsVar(4, 1,MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Str);
if ( strcmp(Str[0],"tensbs3d") != 0)
{
/* Free Str */
if (Str)
{
int i = 0;
while (Str[i] != NULL)
{
FREE(Str[i]);
i++;
};
FREE(Str);
Str = NULL;
}
Scierror(999,_("%s: Wrong type for input argument #%d: %s tlist expected.\n"), fname,4,"tensbs3d");
return 0;
}
/* Free Str */
if (Str)
{
int i = 0;
while (Str[i] != NULL)
{
FREE(Str[i]);
i++;
};
FREE(Str);
Str = NULL;
}
GetListRhsVar(4, 2,MATRIX_OF_DOUBLE_DATATYPE, &mtx, &n, <x);
GetListRhsVar(4, 3,MATRIX_OF_DOUBLE_DATATYPE, &mty, &n, <y);
GetListRhsVar(4, 4,MATRIX_OF_DOUBLE_DATATYPE, &mtz, &n, <z);
GetListRhsVar(4, 5,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m , &n, (int *)&Order);
GetListRhsVar(4, 6,MATRIX_OF_DOUBLE_DATATYPE, &nxyz,&n, &lbcoef);
GetListRhsVar(4, 7,MATRIX_OF_DOUBLE_DATATYPE, &nsix,&n, &lxyzminmax);
xyzminmax = stk(lxyzminmax);
xmin = xyzminmax[0];
xmax = xyzminmax[1];
ymin = xyzminmax[2];
ymax = xyzminmax[3];
zmin = xyzminmax[4];
zmax = xyzminmax[5];
/* get the outmode */
if ( Rhs == 5 )
{
GetRhsScalarString(5, &ns, &str_outmode);
outmode = get_type(OutModeTable, NB_OUTMODE, str_outmode, ns);
if ( outmode == UNDEFINED || outmode == LINEAR || outmode == NATURAL )
{
Scierror(999,_("%s: Wrong values for input argument #%d: Unsupported '%s' type.\n"),fname,5,"outmode");
return 0;
}
}
else
{
outmode = C0;
}
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &lfp); fp = stk(lfp);
order = (int *)Order.D;
kx = order[0];
ky = order[1];
kz = order[2];
nx = mtx - kx;
ny = mty - ky;
nz = mtz - kz;
mwork = ky * kz + 3 *Max(kx, Max(ky, kz)) + kz;
CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &mwork, &one, &lwork);
if (Lhs == 1)
{
C2F(driverdb3val)(xp,yp,zp,fp,&np,stk(ltx), stk(lty), stk(ltz),
&nx, &ny, &nz, &kx, &ky, &kz, stk(lbcoef), stk(lwork),
&xmin, &xmax, &ymin, &ymax, &zmin, &zmax, &outmode);
LhsVar(1) = Rhs + 1;
}
else
{
CreateVar(Rhs + 3, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &ldfpdx);
dfpdx = stk(ldfpdx);
CreateVar(Rhs + 4, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &ldfpdy);
dfpdy = stk(ldfpdy);
CreateVar(Rhs + 5, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &ldfpdz);
dfpdz = stk(ldfpdz);
C2F(driverdb3valwithgrad)(xp,yp,zp,fp,dfpdx, dfpdy, dfpdz, &np,
stk(ltx), stk(lty), stk(ltz),
&nx, &ny, &nz, &kx, &ky, &kz, stk(lbcoef), stk(lwork),
&xmin, &xmax, &ymin, &ymax, &zmin, &zmax, &outmode);
LhsVar(1) = Rhs + 1;
LhsVar(2) = Rhs + 3;
LhsVar(3) = Rhs + 4;
LhsVar(4) = Rhs + 5;
}
PutLhsVar();
return 0;
}
int sci_taucs_chfact(char* fname, void* pvApiCtx)
{
SciErr sciErr;
int stat = 0;
int* perm = NULL;
int* invperm = NULL;
taucs_ccs_matrix *PAPT;
taucs_ccs_matrix B;
void *C = NULL;
taucs_handle_factors *pC;
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;
/* Check numbers of input/output arguments */
CheckInputArgument(pvApiCtx, 1, 1);
CheckOutputArgument(pvApiCtx, 1, 1);
/* get A the sparse matrix to factorize */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isVarComplex(pvApiCtx, piAddr1))
{
iComplex = 1;
sciErr = getComplexSparseMatrix(pvApiCtx, piAddr1, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal, &pdblSpImg);
}
else
{
sciErr = getSparseMatrix(pvApiCtx, piAddr1, &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;
stat = spd_sci_sparse_to_taucs_sparse(&A, &B);
if ( stat != A_PRIORI_OK )
{
if ( stat == MAT_IS_NOT_SPD )
{
freeTaucsSparse(B);
Scierror(999, _("%s: Wrong value for input argument #%d: Must be symmetric positive definite matrix."), fname, 1);
}
/* the message for the other problem (not enough memory in stk) is treated automaticaly */
return 1;
}
/* find the permutation */
taucs_ccs_genmmd(&B, &perm, &invperm);
if ( !perm )
{
freeTaucsSparse(B);
Scierror(999, _("%s: No more memory.\n") , fname);
return 1;
}
/* apply permutation */
PAPT = taucs_ccs_permute_symmetrically(&B, perm, invperm);
FREE(invperm);
freeTaucsSparse(B);
/* factor */
C = taucs_ccs_factor_llt_mf(PAPT);
taucs_ccs_free(PAPT);
if (C == NULL)
{
/* Note : an error indicator is given in the main scilab window
* (out of memory, no positive definite matrix , etc ...)
*/
Scierror(999, _("%s: An error occurred: %s\n"), fname, _("factorization"));
return 1;
}
/* put in an handle (Chol fact + perm + size) */
pC = (taucs_handle_factors*)MALLOC( sizeof(taucs_handle_factors) );
pC->p = perm;
pC->C = C;
pC->n = A.n;
/* add in the list of Chol Factors */
AddAdrToList((Adr) pC, 0, &ListCholFactors); /* FIXME add a test here .. */
/* create the scilab object to store the pointer onto the Chol handle */
sciErr = createPointer(pvApiCtx, 2, (void *)pC);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* return the pointer */
AssignOutputVariable(pvApiCtx, 1) = 2;
ReturnArguments(pvApiCtx);
return 0;
}