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]);
}
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 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;;
}
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 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;
}
static int serialize_double(void *_pvCtx, int *_piAddr, int **_piBuffer, int *_piBufferSize)
{
SciErr sciErr;
int iRows = 0;
int iCols = 0;
int iOne = 1;
int iSize = 0;
double *pdblR = NULL;
double *pdblI = NULL;
int *piOut = NULL;
int iOutLen = 0;
if (isVarComplex(_pvCtx, _piAddr))
{
double *p = NULL;
sciErr = getComplexMatrixOfDouble(_pvCtx, _piAddr, &iRows, &iCols, &pdblR, &pdblI);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
iOutLen = 4 + (2 * iRows * iCols * sizeof(double) / sizeof(int));
piOut = (int *)MALLOC(iOutLen * sizeof(int));
if (piOut == NULL)
{
return 1;
}
piOut[0] = sci_matrix;
piOut[1] = iRows;
piOut[2] = iCols;
piOut[3] = 1; //complex
//move 'p' to first real value
p = (double *)(piOut + 4);
iSize = iRows * iCols;
C2F(dcopy) (&iSize, pdblR, &iOne, p, &iOne);
//move 'p' to first complex value
p = p + iRows * iCols;
C2F(dcopy) (&iSize, pdblI, &iOne, p, &iOne);
}
else
{
double *p = NULL;
sciErr = getMatrixOfDouble(_pvCtx, _piAddr, &iRows, &iCols, &pdblR);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
iOutLen = 4 + (iRows * iCols * sizeof(double) / sizeof(int));
piOut = (int *)MALLOC(iOutLen * sizeof(int));
if (piOut == NULL)
{
return 1;
}
piOut[0] = sci_matrix;
piOut[1] = iRows;
piOut[2] = iCols;
piOut[3] = 0; //not complex
//move 'p' to first value
p = (double *)(piOut + 4);
iSize = iRows * iCols;
C2F(dcopy) (&iSize, pdblR, &iOne, p, &iOne);
}
*_piBuffer = piOut;
*_piBufferSize = iOutLen;
return 0;
}
// =============================================================================
// csvWrite(M, filename[, separator, decimal, precision]) */
// with M string or double (not complex)
// =============================================================================
int sci_csvWrite(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int iErr = 0;
csvWriteError csvError = CSV_WRITE_ERROR;
char *separator = NULL;
char *decimal = NULL;
char *filename = NULL;
char *precisionFormat = NULL;
char **pHeadersLines = NULL;
int nbHeadersLines = 0;
char **pStringValues = NULL;
double *pDoubleValuesReal = NULL;
double *pDoubleValuesImag = NULL;
int bIsComplex = 0;
int mValues = 0;
int nValues = 0;
int *piAddressVarTwo = NULL;
int m2 = 0, n2 = 0;
int iType2 = 0;
int *piAddressVarOne = NULL;
int m1 = 0, n1 = 0;
int iType1 = 0;
CheckRhs(2, 6);
CheckLhs(1, 1);
if (Rhs > 5)
{
int isOnlyRowOrCol = 0;
int m6 = 0;
int n6 = 0;
pHeadersLines = csv_getArgumentAsMatrixOfString(pvApiCtx, 6, fname, &m6, &n6, &iErr);
if (iErr)
{
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
return 0;
}
isOnlyRowOrCol = ((m6 > 1) && (n6 == 1)) || ((m6 == 1) && (n6 > 1)) || ((m6 == 1) && (n6 == 1));
if (!isOnlyRowOrCol)
{
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
Scierror(999, _("%s: Wrong size for input argument #%d: A 1-by-n or m-by-1 array of strings expected.\n"), fname, 6);
return 0;
}
nbHeadersLines = m6 * n6;
}
if (Rhs > 4)
{
if (csv_isDoubleScalar(pvApiCtx, 5))
{
#define FORMAT_FIELDVALUESTR "%%.%dlg"
int iFormatValue = (int) csv_getArgumentAsScalarDouble(pvApiCtx, 5, fname, &iErr);
if (iErr)
{
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
return 0;
}
if ((iFormatValue < 1) || (iFormatValue > 17))
{
Scierror(999, _("%s: Wrong value for input argument #%d: A double (value 1 to 17) expected.\n"), fname, 5);
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
return 0;
}
precisionFormat = (char*)MALLOC(sizeof(char) * ((int)strlen(FORMAT_FIELDVALUESTR) + 1));
if (precisionFormat == NULL)
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
return 0;
}
sprintf(precisionFormat, FORMAT_FIELDVALUESTR, iFormatValue);
}
else
{
precisionFormat = csv_getArgumentAsStringWithEmptyManagement(pvApiCtx, 5, fname, getCsvDefaultPrecision(), &iErr);
if (iErr)
{
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
return 0;
}
if (checkCsvWriteFormat(precisionFormat))
{
Scierror(999, _("%s: Not supported format %s.\n"), fname, precisionFormat);
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
return 0;
}
}
}
else
{
precisionFormat = os_strdup(getCsvDefaultPrecision());
}
if (Rhs > 3)
{
decimal = csv_getArgumentAsStringWithEmptyManagement(pvApiCtx, 4, fname, getCsvDefaultDecimal(), &iErr);
if (iErr)
{
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
return 0;
}
if (strcmp(decimal, ".") && strcmp(decimal, ","))
{
//invalid value
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), "write_csv", 4, ".", ",");
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
return 1;
}
}
else
{
decimal = os_strdup(getCsvDefaultDecimal());
}
if (Rhs > 2)
{
separator = csv_getArgumentAsStringWithEmptyManagement(pvApiCtx, 3, fname, getCsvDefaultSeparator(), &iErr);
if (iErr)
{
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
return 0;
}
}
else
{
separator = os_strdup(getCsvDefaultSeparator());
}
filename = csv_getArgumentAsString(pvApiCtx, 2, fname, &iErr);
if (iErr)
{
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
printError(&sciErr, 0);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarOne, &iType1);
if (sciErr.iErr)
{
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
printError(&sciErr, 0);
return 0;
}
if (iType1 == sci_strings)
{
pStringValues = csv_getArgumentAsMatrixOfString(pvApiCtx, 1, fname, &m1, &n1, &iErr);
if (iErr)
{
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
return 0;
}
}
else if (iType1 == sci_matrix)
{
if (isVarComplex(pvApiCtx, piAddressVarOne))
{
bIsComplex = 1;
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddressVarOne, &m1, &n1, &pDoubleValuesReal, &pDoubleValuesImag);
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &m1, &n1, &pDoubleValuesReal);
}
if (sciErr.iErr)
{
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
printError(&sciErr, 0);
return 0;
}
}
else
{
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of string or a matrix of real expected.\n"), fname, 1);
return 0;
}
if (pStringValues)
{
csvError = csvWrite_string(filename,
(const char**)pStringValues, m1, n1,
separator,
decimal,
(const char**)pHeadersLines, nbHeadersLines);
}
else
{
if (bIsComplex)
{
csvError = csvWrite_complex(filename,
pDoubleValuesReal,
pDoubleValuesImag,
m1, n1,
separator,
decimal,
precisionFormat,
(const char**)pHeadersLines, nbHeadersLines);
}
else
{
csvError = csvWrite_double(filename,
pDoubleValuesReal, m1, n1,
separator,
decimal,
precisionFormat,
(const char**)pHeadersLines, nbHeadersLines);
}
}
switch (csvError)
{
case CSV_WRITE_SEPARATOR_DECIMAL_EQUAL:
{
Scierror(999, _("%s: separator and decimal must have different values.\n"), fname);
}
break;
case CSV_WRITE_NO_ERROR:
{
LhsVar(1) = 0;
PutLhsVar();
}
break;
case CSV_WRITE_FOPEN_ERROR:
{
Scierror(999, _("%s: can not open file %s.\n"), fname, filename);
}
break;
default:
case CSV_WRITE_ERROR:
{
Scierror(999, _("%s: error.\n"), fname);
}
break;
}
freeVar(&separator, &decimal, &filename, &precisionFormat, &pHeadersLines, nbHeadersLines);
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 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_res_with_prec(char* fname, void* pvApiCtx)
{
SciErr sciErr;
int mx = 0, nx = 0, mb = 0, nb = 0, i = 0;
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;
double* pdblXR = NULL;
double* pdblXI = NULL;
double* pdblBR = NULL;
double* pdblBI = NULL;
double* pdblNR = NULL;
double* pdblNI = NULL;
double* pdblRR = NULL;
double* pdblRI = NULL;
int nbInputArg = nbInputArgument(pvApiCtx);
/* Check numbers of input/output arguments */
CheckInputArgument(pvApiCtx, 3, 3);
CheckOutputArgument(pvApiCtx, 1, 2);
/* get A the sparse matrix */
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;
/* get x */
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isVarComplex(pvApiCtx, piAddr2))
{
iComplex = 1;
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddr2, &mx, &nx, &pdblXR, &pdblXI);
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddr2, &mx, &nx, &pdblXR);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* get b */
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isVarComplex(pvApiCtx, piAddr3))
{
iComplex = 1;
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddr3, &mb, &nb, &pdblBR, &pdblBI);
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddr3, &mb, &nb, &pdblBR);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* check size of inputs */
if ( nx < 1 || nb != nx || mx != nA || mb != mA )
{
Scierror(999, _("%s: Wrong size for input arguments: Same sizes expected.\n"), fname);
return 1;
}
/* Create the matrix as return of the function */
if (iComplex)
{
sciErr = allocComplexMatrixOfDouble(pvApiCtx, 4, mb, nb, &pdblRR, &pdblRI);
}
else
{
sciErr = allocMatrixOfDouble(pvApiCtx, 4, mb, nb, &pdblRR);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* Create the matrix as return of the function */
sciErr = allocMatrixOfDouble(pvApiCtx, 5, 1, nb, &pdblNR);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* perform operations */
if (iComplex == 0)
{
for ( i = 0 ; i < nb ; i++ )
{
residu_with_prec(&A, pdblXR + i * mx, pdblBR + i * mb, pdblRR + i * mb, pdblNR + i);
}
}
else
{
if (pdblXI == NULL)
{
int iSize = mx * nx * sizeof(double);
pdblXI = (double*)MALLOC(iSize);
memset(pdblXI, 0x00, iSize);
}
if (pdblBI == NULL)
{
int iSize = mb * nb * sizeof(double);
pdblBI = (double*)MALLOC(iSize);
memset(pdblBI, 0x00, iSize);
}
if (pdblSpImg == NULL)
{
/* Create the matrix as return of the function */
int iSize = nb * sizeof(double);
pdblNI = (double*)MALLOC(iSize);
memset(pdblNI, 0x00, iSize);
for ( i = 0 ; i < nb ; i++ )
{
residu_with_prec(&A, pdblXR + i * mx, pdblBR + i * mb, pdblRR + i * mb, pdblNR + i);
}
for ( i = 0 ; i < nb ; i++ )
{
residu_with_prec(&A, pdblXI + i * mx, pdblBI + i * mb, pdblRI + i * mb, pdblNI + i);
}
for ( i = 0 ; i < nb ; i++ )
{
pdblNR[i] = sqrt(pdblNR[i] * pdblNR[i] + pdblNI[i] * pdblNI[i]);
}
}
else
{
for ( i = 0 ; i < nb ; i++ )
{
cmplx_residu_with_prec(&A, pdblXR + i * mx, pdblXI + i * mx,
pdblBR + i * mb, pdblBI + i * mb,
pdblRR + i * mb, pdblRI + i * mb,
pdblNR + i);
}
}
}
if (isVarComplex(pvApiCtx, piAddr1) == 0)
{
FREE(pdblNI);
}
if (isVarComplex(pvApiCtx, piAddr2) == 0)
{
FREE(pdblXI);
}
if (isVarComplex(pvApiCtx, piAddr3) == 0)
{
FREE(pdblBI);
}
AssignOutputVariable(pvApiCtx, 1) = 4;
AssignOutputVariable(pvApiCtx, 2) = 5;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_prod(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int iRows = 0;
int iCols = 0;
int*piAddr = NULL;
double* pdblReal = NULL;
double* pdblImg = NULL;
int iRowsRet = 0;
int iColsRet = 0;
double* pdblRealRet = NULL;
double* pdblImgRet = NULL;
int iMode = 0;
CheckRhs(1, 2);
CheckLhs(1, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if (Rhs == 2)
{
sciErr = getProcessMode(pvApiCtx, 2, piAddr, &iMode);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
}
sciErr = getVarDimension(pvApiCtx, piAddr, &iRows, &iCols);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if (iRows * iCols == 0)
{
double dblVal = 0;
if (iMode == 0)
{
iRows = 1;
iCols = 1;
dblVal = 1;
}
else
{
iRows = 0;
iCols = 0;
}
sciErr = createMatrixOfDouble(pvApiCtx, Rhs + 1, 1, 1, &dblVal);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
switch (iMode)
{
case BY_ROWS :
iRowsRet = 1;
iColsRet = iCols;
break;
case BY_COLS :
iRowsRet = iRows;
iColsRet = 1;
break;
default : //BY_ALL
iRowsRet = 1;
iColsRet = 1;
break;
}
if (isVarComplex(pvApiCtx, piAddr))
{
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddr, &iRows, &iCols, &pdblReal, &pdblImg);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = allocComplexMatrixOfDouble(pvApiCtx, Rhs + 1, iRowsRet, iColsRet, &pdblRealRet, &pdblImgRet);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
vWDmProd(iMode, pdblReal, pdblImg, iRows, iRows, iCols, pdblRealRet, pdblImgRet, 1);
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddr, &iRows, &iCols, &pdblReal);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = allocMatrixOfDouble(pvApiCtx, Rhs + 1, iRowsRet, iColsRet, &pdblRealRet);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
vDmProd(iMode, pdblReal, iRows, iRows, iCols, pdblRealRet, 1);
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
int ScilabObjects::getArgumentId(int * addr, int * tmpvars, const bool isRef, const bool isClass, const int envId, void * pvApiCtx)
{
SciErr err;
int typ, row = 0, col = 0, returnId;
const ScilabAbstractEnvironmentWrapper & wrapper = ScilabEnvironments::getEnvironment(envId).getWrapper();
err = getVarType(pvApiCtx, addr, &typ);
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
if (isClass && typ != sci_mlist)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("External Class expected"));
}
switch (typ)
{
case sci_matrix :
{
double * mat = 0;
if (isVarComplex(pvApiCtx, addr))
{
double * imag = 0;
err = getComplexMatrixOfDouble(pvApiCtx, addr, &row, &col, &mat, &imag);
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
returnId = wrap(row, col, mat, imag, wrapper, isRef);
}
else
{
err = getMatrixOfDouble(pvApiCtx, addr, &row, &col, &mat);
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
returnId = wrap<double>(row, col, mat, wrapper, isRef);
}
tmpvars[++tmpvars[0]] = returnId;
return returnId;
}
case sci_ints :
{
int prec = 0;
void * ints = 0;
err = getMatrixOfIntegerPrecision(pvApiCtx, addr, &prec);
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
switch (prec)
{
case SCI_INT8 :
err = getMatrixOfInteger8(pvApiCtx, addr, &row, &col, (char**)(&ints));
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
returnId = wrap<char>(row, col, static_cast<char *>(ints), wrapper, isRef);
tmpvars[++tmpvars[0]] = returnId;
return returnId;
case SCI_UINT8 :
err = getMatrixOfUnsignedInteger8(pvApiCtx, addr, &row, &col, (unsigned char**)(&ints));
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
returnId = wrap<unsigned char>(row, col, static_cast<unsigned char *>(ints), wrapper, isRef);
tmpvars[++tmpvars[0]] = returnId;
return returnId;
case SCI_INT16 :
err = getMatrixOfInteger16(pvApiCtx, addr, &row, &col, (short**)(&ints));
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
returnId = wrap<short>(row, col, static_cast<short *>(ints), wrapper, isRef);
tmpvars[++tmpvars[0]] = returnId;
return returnId;
case SCI_UINT16 :
err = getMatrixOfUnsignedInteger16(pvApiCtx, addr, &row, &col, (unsigned short**)(&ints));
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
returnId = wrap<unsigned short>(row, col, static_cast<unsigned short *>(ints), wrapper, isRef);
tmpvars[++tmpvars[0]] = returnId;
return returnId;
case SCI_INT32 :
err = getMatrixOfInteger32(pvApiCtx, addr, &row, &col, (int**)(&ints));
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
returnId = wrap<int>(row, col, static_cast<int *>(ints), wrapper, isRef);
tmpvars[++tmpvars[0]] = returnId;
return returnId;
case SCI_UINT32 :
err = getMatrixOfUnsignedInteger32(pvApiCtx, addr, &row, &col, (unsigned int**)(&ints));
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
returnId = wrap<unsigned int>(row, col, static_cast<unsigned int *>(ints), wrapper, isRef);
tmpvars[++tmpvars[0]] = returnId;
return returnId;
#ifdef __SCILAB_INT64__
case SCI_INT64 :
err = getMatrixOfInteger64(pvApiCtx, addr, &row, &col, (long long**)(&ints));
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
returnId = wrap<long long>(row, col, static_cast<long long *>(ints), wrapper, isRef);
tmpvars[++tmpvars[0]] = returnId;
return returnId;
case SCI_UINT64 :
err = getMatrixOfUnsignedInteger64(pvApiCtx, addr, &row, &col, (unsigned long long**)(&ints));
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
returnId = wrap<unsigned long long>(row, col, static_cast<unsigned long long *>(ints), wrapper, isRef);
tmpvars[++tmpvars[0]] = returnId;
return returnId;
#endif
}
}
case sci_strings :
{
char ** matS = NULL;
if (getAllocatedMatrixOfString(pvApiCtx, addr, &row, &col, &matS))
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
returnId = wrap<char *>(row, col, matS, wrapper, isRef);
freeAllocatedMatrixOfString(row, col, matS);
tmpvars[++tmpvars[0]] = returnId;
return returnId;
}
case sci_boolean :
{
int * matB;
err = getMatrixOfBoolean(pvApiCtx, addr, &row, &col, &matB);
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
returnId = wrapBool(row, col, matB, wrapper, isRef);
tmpvars[++tmpvars[0]] = returnId;
return returnId;
}
case sci_mlist :
{
int * id = 0;
int type = getMListType(addr, pvApiCtx);
int eId = getEnvironmentId(addr, pvApiCtx);
if (eId != envId)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Incompatible External Objects"));
}
if (isClass)
{
if (type == EXTERNAL_CLASS)
{
err = getMatrixOfInteger32InList(pvApiCtx, addr, EXTERNAL_OBJ_ID_POSITION, &row, &col, &id);
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
return *id;
}
else
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("External Class expected"));
}
}
if (type == EXTERNAL_OBJECT || type == EXTERNAL_CLASS)
{
err = getMatrixOfInteger32InList(pvApiCtx, addr, EXTERNAL_OBJ_ID_POSITION, &row, &col, &id);
if (err.iErr)
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Invalid variable: cannot retrieve the data"));
}
return *id;
}
else if (type == EXTERNAL_VOID)
{
return -1;
}
else
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("External object expected"));
}
break;
}
default :
{
removeTemporaryVars(envId, tmpvars);
throw ScilabAbstractEnvironmentException(__LINE__, __FILE__, gettext("Unable to wrap. Unmanaged datatype ?"));
}
}
}
int read_double(char *fname,unsigned long fname_len)
{
SciErr sciErr;
int i;
//first variable info : real matrix of double
int iType = 0;
int iRows = 0;
int iCols = 0;
int iComplex = 0;
int *piAddr = NULL;
double* pdblReal = NULL;
double* pdblImg = NULL;
//check input and output arguments
CheckInputArgument(pvApiCtx, 1, 1);
CheckOutputArgument(pvApiCtx, 1, 1);
/************************
* First variable *
************************/
//get variable address of the first input argument
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
//check type
sciErr = getVarType(pvApiCtx, piAddr, &iType);
if(sciErr.iErr || iType != sci_matrix)
{
printError(&sciErr, 0);
return 0;
}
//get complexity
iComplex = isVarComplex(pvApiCtx, piAddr);
//check complexity
if(iComplex)
{
//get size and data from Scilab memory
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddr, &iRows, &iCols, &pdblReal, &pdblImg);
}
else
{
//get size and data from Scilab memory
sciErr = getMatrixOfDouble(pvApiCtx, piAddr, &iRows, &iCols, &pdblReal);
}
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
//Do something with data
//if variable is complex, switch real part and imaginary part otherwise multiply by -1
if(iComplex)
{
sciErr = createComplexMatrixOfDouble(pvApiCtx, InputArgument + 1, iRows, iCols, pdblImg, pdblReal);
}
else
{
for(i = 0 ; i < iRows * iCols ; i++)
{
pdblReal[i] = pdblReal[i] * -1;
}
sciErr = createMatrixOfDouble(pvApiCtx, InputArgument + 1, iRows, iCols, pdblReal);
}
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
AssignOutputVariable(1) = InputArgument + 1;
return 0;
}
int sci_gpuMatrix(char *fname)
{
CheckRhs(2, 3);
CheckLhs(1, 1);
SciErr sciErr;
int* piAddr_A = NULL;
int inputType_A = 0;
int* piAddr_R = NULL;
int inputType_R = 0;
int* piAddr_C = NULL;
int inputType_C = 0;
int rows = 0;
int cols = 0;
int newRows = 0;
int newCols = 0;
void* pvPtr = NULL;
GpuPointer* gpuPtrA = NULL;
try
{
if (!isGpuInit())
{
throw "gpu is not initialised. Please launch gpuInit() before use this function.";
}
//--- Get input matrix ---
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr_A);
if (sciErr.iErr)
{
throw sciErr;
}
// Get size and data
sciErr = getVarType(pvApiCtx, piAddr_A, &inputType_A);
if (sciErr.iErr)
{
throw sciErr;
}
//--- Get new Rows size or vector of sizes---
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr_R);
if (sciErr.iErr)
{
throw sciErr;
}
// Get size and data
sciErr = getVarType(pvApiCtx, piAddr_R, &inputType_R);
if (sciErr.iErr)
{
throw sciErr;
}
if (inputType_R != sci_matrix)
{
throw "gpuMatrix : Bad type for input argument #2: A real scalar or row vector expected.";
}
if (isVarComplex(pvApiCtx, piAddr_A))
{
throw "gpuMatrix : Bad type for input argument #2: A real scalar or row vector expected.";
}
else
{
double* dRows = NULL;
sciErr = getMatrixOfDouble(pvApiCtx, piAddr_R, &rows, &cols, &dRows);
if (sciErr.iErr)
{
throw sciErr;
}
if (nbInputArgument(pvApiCtx) == 2)
{
if (rows != 1 || cols != 2)
{
throw "gpuMatrix : Bad size for input argument #2: A row vector of size two expected.";
}
newRows = (int)dRows[0];
newCols = (int)dRows[1];
if (newCols < -1 || newCols == 0)
{
throw "gpuMatrix : Wrong value for input argument #3: -1 or positive value expected.";
}
}
else
{
newRows = (int)(*dRows);
}
if (newRows < -1 || newRows == 0)
{
throw "gpuMatrix : Wrong value for input argument #2: -1 or positive value expected.";
}
}
if (nbInputArgument(pvApiCtx) == 3)
{
//--- Get new Cols size---
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr_C);
if (sciErr.iErr)
{
throw sciErr;
}
// Get size and data
sciErr = getVarType(pvApiCtx, piAddr_C, &inputType_C);
if (sciErr.iErr)
{
throw sciErr;
}
if (inputType_C != sci_matrix)
{
throw "gpuMatrix : Bad type for input argument #3: A real scalar expected.";
}
if (isVarComplex(pvApiCtx, piAddr_A))
{
throw "gpuMatrix : Bad type for input argument #3: A real scalar expected.";
}
else
{
double* dCols = NULL;
sciErr = getMatrixOfDouble(pvApiCtx, piAddr_C, &rows, &cols, &dCols);
if (sciErr.iErr)
{
throw sciErr;
}
newCols = (int)(*dCols);
if (newCols < -1 || newCols == 0)
{
throw "gpuMatrix : Wrong value for input argument #3: -1 or positive value expected.";
}
}
}
if (inputType_A == sci_pointer)
{
sciErr = getPointer(pvApiCtx, piAddr_A, (void**)&pvPtr);
if (sciErr.iErr)
{
throw sciErr;
}
gpuPtrA = (GpuPointer*)pvPtr;
if (!PointerManager::getInstance()->findGpuPointerInManager(gpuPtrA))
{
throw "gpuMatrix : Bad type for input argument #1: Variables created with GPU functions expected.";
}
if (useCuda() && gpuPtrA->getGpuType() != GpuPointer::CudaType)
{
throw "gpuMatrix : Bad type for input argument #1: A Cuda pointer expected.";
}
if (useCuda() == false && gpuPtrA->getGpuType() != GpuPointer::OpenCLType)
{
throw "gpuMatrix : Bad type for input argument #1: A OpenCL pointer expected.";
}
rows = gpuPtrA->getRows();
cols = gpuPtrA->getCols();
}
else if (inputType_A == sci_matrix)
{
double* h = NULL;
if (isVarComplex(pvApiCtx, piAddr_A))
{
double* hi = NULL;
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddr_A, &rows, &cols, &h, &hi);
#ifdef WITH_CUDA
if (useCuda())
{
gpuPtrA = new PointerCuda(h, hi, rows, cols);
}
#endif
#ifdef WITH_OPENCL
if (!useCuda())
{
Scierror(999, "gpuMatrix: not implemented with OpenCL.\n");
}
#endif
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddr_A, &rows, &cols, &h);
#ifdef WITH_CUDA
if (useCuda())
{
gpuPtrA = new PointerCuda(h, rows, cols);
}
#endif
#ifdef WITH_OPENCL
if (!useCuda())
{
Scierror(999, "gpuMatrix: not implemented with OpenCL.\n");
}
#endif
}
if (sciErr.iErr)
{
throw sciErr;
}
}
else
{
throw "gpuMatrix : Bad type for input argument #1: A GPU or CPU matrix expected.";
}
if (newRows == -1 && newCols != -1)
{
newRows = rows * cols / newCols;
}
else if (newRows != -1 && newCols == -1)
{
newCols = rows * cols / newRows;
}
if (rows * cols != newRows * newCols)
{
throw "gpuMatrix : Wrong value for input arguments #2 and 3: Correct size expected.";
}
#ifdef WITH_OPENCL
if (!useCuda())
{
Scierror(999, "gpuMatrix: not implemented with OpenCL.\n");
}
#endif
GpuPointer* gpuOut = gpuPtrA->clone();
gpuOut->setRows(newRows);
gpuOut->setCols(newCols);
// Put the result in scilab
PointerManager::getInstance()->addGpuPointerInManager(gpuOut);
sciErr = createPointer(pvApiCtx, Rhs + 1, (void*)gpuOut);
LhsVar(1) = Rhs + 1;
if (inputType_A == 1 && gpuPtrA != NULL)
{
delete gpuPtrA;
}
PutLhsVar();
return 0;
}
catch (const char* str)
{
Scierror(999, "%s\n", str);
}
catch (SciErr E)
{
printError(&E, 0);
}
if (inputType_A == 1 && gpuPtrA != NULL)
{
delete gpuPtrA;
}
return EXIT_FAILURE;
}
int sci_umf_lusolve(char* fname, unsigned long l)
{
SciErr sciErr;
int mb = 0;
int nb = 0;
int it_flag = 0;
int i = 0;
int j = 0;
int NoTranspose = 0;
int NoRaffinement = 0;
SciSparse AA;
CcsSparse A;
/* umfpack stuff */
double Info[UMFPACK_INFO]; // double *Info = (double *) NULL;
double Control[UMFPACK_CONTROL];
void* Numeric = NULL;
int lnz = 0, unz = 0, n = 0, n_col = 0, nz_udiag = 0, umf_flag = 0;
int* Wi = NULL;
int mW = 0;
double *W = NULL;
int iComplex = 0;
int* piAddr1 = NULL;
int* piAddr2 = NULL;
int* piAddr3 = NULL;
int* piAddr4 = NULL;
double* pdblBR = NULL;
double* pdblBI = NULL;
double* pdblXR = NULL;
double* pdblXI = NULL;
int mA = 0; // rows
int nA = 0; // cols
int iNbItem = 0;
int* piNbItemRow = NULL;
int* piColPos = NULL;
double* pdblSpReal = NULL;
double* pdblSpImg = NULL;
/* Check numbers of input/output arguments */
CheckInputArgument(pvApiCtx, 2, 4);
CheckOutputArgument(pvApiCtx, 1, 1);
/* First get arg #1 : the pointer to the LU factors */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getPointer(pvApiCtx, piAddr1, &Numeric);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* Check if this pointer is a valid ref to a umfpack LU numeric object */
if ( ! IsAdrInList(Numeric, ListNumeric, &it_flag) )
{
Scierror(999, _("%s: Wrong value for input argument #%d: Must be a valid reference to (umf) LU factors.\n"), fname, 1);
return 1;
}
/* get some parameters of the factorization (for some checking) */
if ( it_flag == 0 )
{
umfpack_di_get_lunz(&lnz, &unz, &n, &n_col, &nz_udiag, Numeric);
}
else
{
iComplex = 1;
umfpack_zi_get_lunz(&lnz, &unz, &n, &n_col, &nz_udiag, Numeric);
}
if ( n != n_col )
{
Scierror(999, _("%s: An error occurred: %s.\n"), fname, _("This is not a factorization of a square matrix"));
return 1;
}
if ( nz_udiag < n )
{
Scierror(999, _("%s: An error occurred: %s.\n"), fname, _("This is a factorization of a singular matrix"));
return 1;
}
/* Get now arg #2 : the vector b */
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isVarComplex(pvApiCtx, piAddr2))
{
iComplex = 1;
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddr2, &mb, &nb, &pdblBR, &pdblBI);
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddr2, &mb, &nb, &pdblBR);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (mb != n || nb < 1) /* test if the right hand side is compatible */
{
Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, 2);
return 1;
}
/* allocate memory for the solution x */
if (iComplex)
{
sciErr = allocComplexMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, mb, nb, &pdblXR, &pdblXI);
}
else
{
sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, mb, nb, &pdblXR);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* selection between the different options :
* -- solving Ax=b or A'x=b (Note: we could add A.'x=b)
* -- with or without raffinement
*/
if (nbInputArgument(pvApiCtx) == 2)
{
NoTranspose = 1;
NoRaffinement = 1;
}
else /* 3 or 4 input arguments but the third must be a string */
{
char* pStr = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
getAllocatedSingleString(pvApiCtx, piAddr3, &pStr);
if (strcmp(pStr, "Ax=b") == 0)
{
NoTranspose = 1;
}
else if ( strcmp(pStr, "A'x=b") == 0 )
{
NoTranspose = 0;
}
else
{
Scierror(999, _("%s: Wrong input argument #%d: '%s' or '%s' expected.\n"), fname, 3, "Ax=b", "A'x=b");
return 1;
}
if (nbInputArgument(pvApiCtx) == 4)
{
sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddr4);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isVarComplex(pvApiCtx, piAddr4))
{
AA.it = 1;
sciErr = getComplexSparseMatrix(pvApiCtx, piAddr4, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal, &pdblSpImg);
}
else
{
AA.it = 0;
sciErr = getSparseMatrix(pvApiCtx, piAddr4, &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;
/* some check... but we can't be sure that the matrix corresponds to the LU factors */
if ( mA != nA || mA != n || AA.it != it_flag )
{
Scierror(999, _("%s: Wrong size for input argument #%d: %s.\n"), fname, 4, _("Matrix is not compatible with the given LU factors"));
return 1;
}
NoRaffinement = 0;
}
else
{
NoRaffinement = 1; /* only 3 input var => no raffinement */
}
}
/* allocate memory for umfpack_di_wsolve usage or umfpack_zi_wsolve usage*/
Wi = (int*)MALLOC(n * sizeof(int));
if (it_flag == 1)
{
if (NoRaffinement)
{
mW = 4 * n;
}
else
{
mW = 10 * n;
}
}
else
{
if (NoRaffinement)
{
mW = n;
}
else
{
mW = 5 * n;
}
}
W = (double*)MALLOC(mW * sizeof(double));
if (NoRaffinement == 0)
{
SciSparseToCcsSparse(&AA, &A);
}
else
{
A.p = NULL;
A.irow = NULL;
A.R = NULL;
A.I = NULL;
}
/* get the pointer for b */
if (it_flag == 1 && pdblBI == NULL)
{
int iSize = mb * nb * sizeof(double);
pdblBI = (double*)MALLOC(iSize);
memset(pdblBI, 0x00, iSize);
}
/* init Control */
if (it_flag == 0)
{
umfpack_di_defaults(Control);
}
else
{
umfpack_zi_defaults(Control);
}
if (NoRaffinement)
{
Control[UMFPACK_IRSTEP] = 0;
}
if (NoTranspose)
{
umf_flag = UMFPACK_A;
}
else
{
umf_flag = UMFPACK_At;
}
if (it_flag == 0)
{
for (j = 0; j < nb ; j++)
{
umfpack_di_wsolve(umf_flag, A.p, A.irow, A.R, &pdblXR[j * mb], &pdblBR[j * mb], Numeric, Control, Info, Wi, W);
}
if (iComplex == 1)
{
for (j = 0; j < nb ; j++)
{
umfpack_di_wsolve(umf_flag, A.p, A.irow, A.R, &pdblXI[j * mb], &pdblBI[j * mb], Numeric, Control, Info, Wi, W);
}
}
}
else
{
for (j = 0; j < nb ; j++)
{
umfpack_zi_wsolve(umf_flag, A.p, A.irow, A.R, A.I, &pdblXR[j * mb], &pdblXI[j * mb], &pdblBR[j * mb], &pdblBI[j * mb], Numeric, Control, Info, Wi, W);
}
}
if (isVarComplex(pvApiCtx, piAddr2) == 0)
{
FREE(pdblBI);
}
freeCcsSparse(A);
FREE(W);
FREE(Wi);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
