int allocSingleString(void* _pvCtx, int _iVar, int _iLen, const char** _pstStrings)
{
SciErr sciErr = sciErrInit();
types::GatewayStruct* pGstr = (types::GatewayStruct*)_pvCtx;
types::typed_list in = *pGstr->m_pIn;
types::InternalType** out = pGstr->m_pOut;
types::String *pStr = NULL;
char* pstStrings = new char[_iLen];
memset(pstStrings, ' ', _iLen);
if (_pstStrings == NULL)
{
addErrorMessage(&sciErr, API_ERROR_NO_MORE_MEMORY, _("%s: No more memory to allocate variable"), "allocSingleString");
return sciErr.iErr;
}
_pstStrings[0] = pstStrings;
pStr = new types::String(pstStrings);
if (pStr == NULL)
{
addErrorMessage(&sciErr, API_ERROR_NO_MORE_MEMORY, _("%s: No more memory to allocate variable"), "allocSingleString");
return sciErr.iErr;
}
int rhs = _iVar - *getNbInputArgument(_pvCtx);
out[rhs - 1] = pStr;
return sciErr.iErr;
}
SciErr createComplexHypermatOfPoly(void *_pvCtx, int _iVar, char* _pstVarName, int * _dims, int _ndims, const int* _piNbCoef, const double* const* _pdblReal, const double* const* _pdblImg)
{
SciErr sciErr = sciErrInit();
types::GatewayStruct* pStr = (types::GatewayStruct*)_pvCtx;
types::typed_list in = *pStr->m_pIn;
types::InternalType** out = pStr->m_pOut;
int rhs = _iVar - *getNbInputArgument(_pvCtx);
wchar_t* w = to_wide_string(_pstVarName);
types::Polynom* p = new types::Polynom(w, _ndims, _dims, _piNbCoef);
p->setComplex(true);
int size = p->getSize();
if (size == 0)
{
delete p;
out[rhs - 1] = types::Double::Empty();
FREE(w);
return sciErr;
}
types::SinglePoly** s = p->get();
for (int i = 0; i < size; ++i)
{
s[i]->setCoef(_pdblReal[i], _pdblImg[i]);
}
out[rhs - 1] = p;
FREE(w);
return sciErr;
}
SciErr createHypermatOfString(void *_pvCtx, int _iVar, int * _dims, int _ndims, const char* const* _pstStrings)
{
SciErr sciErr = sciErrInit();
types::GatewayStruct* pStr = (types::GatewayStruct*)_pvCtx;
types::typed_list in = *pStr->m_pIn;
types::InternalType** out = pStr->m_pOut;
int rhs = _iVar - *getNbInputArgument(_pvCtx);
types::String* p = new types::String(_ndims, _dims);
int size = p->getSize();
if (size == 0)
{
delete p;
out[rhs - 1] = types::Double::Empty();
return sciErr;
}
for (int i = 0; i < size; ++i)
{
wchar_t* w = to_wide_string(_pstStrings[i]);
p->set(i, w);
FREE(w);
}
out[rhs - 1] = p;
return sciErr;
}
SciErr createCommonMatrixOfPoly(void* _pvCtx, int _iVar, int _iComplex, char* _pstVarName, int _iRows, int _iCols, const int* _piNbCoef, const double* const* _pdblReal, const double* const* _pdblImg)
{
SciErr sciErr = sciErrInit();
if (_pvCtx == NULL)
{
addErrorMessage(&sciErr, API_ERROR_INVALID_POINTER, _("%s: Invalid argument address"), _iComplex ? "createComplexMatrixOfPoly" : "createMatrixOfPoly");
return sciErr;
}
types::GatewayStruct* pStr = (types::GatewayStruct*)_pvCtx;
types::InternalType** out = pStr->m_pOut;
int rhs = _iVar - *getNbInputArgument(_pvCtx);
//return empty matrix
if (_iRows == 0 && _iCols == 0)
{
types::Double *pDbl = new types::Double(_iRows, _iCols);
if (pDbl == NULL)
{
addErrorMessage(&sciErr, API_ERROR_CREATE_EMPTY_MATRIX, _("%s: Unable to create variable in Scilab memory"), "createEmptyMatrix");
return sciErr;
}
out[rhs - 1] = pDbl;
return sciErr;
}
wchar_t* pstTemp = to_wide_string(_pstVarName);
std::wstring wstTemp(pstTemp);
types::Polynom* pP = new types::Polynom(wstTemp, _iRows, _iCols, _piNbCoef);
FREE(pstTemp);
if (pP == NULL)
{
addErrorMessage(&sciErr, API_ERROR_NO_MORE_MEMORY, _("%s: No more memory to allocated variable"), _iComplex ? "createComplexMatrixOfPoly" : "createMatrixOfPoly");
return sciErr;
}
if (_iComplex)
{
pP->setComplex(true);
}
out[rhs - 1] = pP;
for (int i = 0 ; i < pP->getSize() ; i++)
{
types::Double* pD = new types::Double(_piNbCoef[i], 1, _iComplex == 1);
pD->set(_pdblReal[i]);
if (_iComplex)
{
pD->setImg(_pdblImg[i]);
}
pP->setCoef(i, pD);
delete pD;
}
return sciErr;
}
/*--------------------------------------------------------------------------*/
SciErr createMatrixOfString(void* _pvCtx, int _iVar, int _iRows, int _iCols, const char* const * _pstStrings)
{
SciErr sciErr = sciErrInit();
int rhs = _iVar - *getNbInputArgument(_pvCtx);
types::GatewayStruct* pStr = (types::GatewayStruct*)_pvCtx;
types::InternalType** out = pStr->m_pOut;
//return empty matrix
if (_iRows == 0 && _iCols == 0)
{
types::Double *pDbl = new types::Double(_iRows, _iCols);
if (pDbl == NULL)
{
addErrorMessage(&sciErr, API_ERROR_CREATE_EMPTY_MATRIX, _("%s: Unable to create variable in Scilab memory"), "createEmptyMatrix");
return sciErr;
}
out[rhs - 1] = pDbl;
return sciErr;
}
types::String* pS = new types::String(_iRows, _iCols);
if (pS == NULL)
{
addErrorMessage(&sciErr, API_ERROR_NO_MORE_MEMORY, _("%s: No more memory to allocated variable"), "createMatrixOfString");
return sciErr;
}
for (int i = 0 ; i < pS->getSize() ; i++)
{
wchar_t* pstTemp = to_wide_string(_pstStrings[i]);
pS->set(i, pstTemp);
FREE(pstTemp);
}
out[rhs - 1] = pS;
return sciErr;
}
SciErr createHypermatOfUnsignedInteger64(void *_pvCtx, int _iVar, int * _dims, int _ndims, const unsigned long long* _pullData64)
{
SciErr sciErr = sciErrInit();
types::GatewayStruct* pStr = (types::GatewayStruct*)_pvCtx;
types::typed_list in = *pStr->m_pIn;
types::InternalType** out = pStr->m_pOut;
int rhs = _iVar - *getNbInputArgument(_pvCtx);
types::UInt64* p = new types::UInt64(_ndims, _dims);
int size = p->getSize();
if (size == 0)
{
delete p;
out[rhs - 1] = types::Double::Empty();
return sciErr;
}
p->set(_pullData64);
out[rhs - 1] = p;
return sciErr;
}
SciErr createHypermatOfBoolean(void *_pvCtx, int _iVar, int * _dims, int _ndims, const int * _piBool)
{
SciErr sciErr = sciErrInit();
types::GatewayStruct* pStr = (types::GatewayStruct*)_pvCtx;
types::typed_list in = *pStr->m_pIn;
types::InternalType** out = pStr->m_pOut;
int rhs = _iVar - *getNbInputArgument(_pvCtx);
types::Bool* p = new types::Bool(_ndims, _dims);
int size = p->getSize();
if (size == 0)
{
delete p;
out[rhs - 1] = types::Double::Empty();
return sciErr;
}
p->set(_piBool);
out[rhs - 1] = p;
return sciErr;
}
SciErr allocHypermatOfDouble(void *_pvCtx, int _iVar, int * _dims, int _ndims, double** _pdblReal)
{
SciErr sciErr = sciErrInit();
types::GatewayStruct* pStr = (types::GatewayStruct*)_pvCtx;
types::typed_list in = *pStr->m_pIn;
types::InternalType** out = pStr->m_pOut;
int rhs = _iVar - *getNbInputArgument(_pvCtx);
types::Double* p = new types::Double(_ndims, _dims);
int size = p->getSize();
if (size == 0)
{
delete p;
out[rhs - 1] = types::Double::Empty();
return sciErr;
}
*_pdblReal = p->get();
out[rhs - 1] = p;
return sciErr;
}
/*--------------------------------------------------------------------------*/
int sci_fft_gen(void* _pvCtx, char *fname, int ndimsA, int *dimsA, double *Ar, double *Ai, int isn, int iopt, guru_dim_struct gdim)
{
/* API variables */
SciErr sciErr;
/* Input array variables */
int isrealA = (Ai == NULL), issymA = 1, lA = 1;
/*for MKL*/
int isrealA_save = isrealA ;
/*FFTW specific library variable */
enum Scaling scale = None;
enum Plan_Type type;
fftw_plan p;
/* input/output address for transform variables */
double *ri = NULL, *ii = NULL, *ro = NULL, *io = NULL;
/* for MKL special cases */
int * dims1 = NULL;
int * incr1 = NULL;
/* local variable */
int one = 1;
int i = 0;
int errflag = 0;
for (i = 0; i < ndimsA; i++)
{
lA *= dimsA[i];
}
if (iopt == 0)
{
/* automatically selected algorithm*/
issymA = check_array_symmetry(Ar, Ai, gdim);
if (issymA < 0 )
{
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 0;
}
}
else if (iopt == 1)
{
issymA = 1; /* user forces symmetry */
}
else
{
issymA = 0;
}
AssignOutputVariable(_pvCtx, 1) = 1;/* assume inplace transform*/
if (WITHMKL)
{
double dzero = 0.0;
if (isrealA)
{
/*MKL does not implement the r2c nor r2r guru split methods, make A complex */
if (issymA)
{
/* result will be real, the imaginary part of A can be allocated alone */
sciErr = allocMatrixOfDouble(pvApiCtx, *getNbInputArgument(_pvCtx) + 1, 1, lA, &Ai);
if (sciErr.iErr)
{
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 0;
}
C2F(dset)(&lA, &dzero, Ai, &one);
}
else
{
/* result will be complex, realloc A for inplace computation */
sciErr = allocComplexArrayOfDouble(pvApiCtx, *getNbInputArgument(_pvCtx) + 1, ndimsA, dimsA, &ri, &Ai);
if (sciErr.iErr)
{
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 0;
}
C2F(dcopy)(&lA, Ar, &one, ri, &one);
Ar = ri;
C2F(dset)(&lA, &dzero, Ai, &one);
AssignOutputVariable(_pvCtx, 1) = nbInputArgument(_pvCtx) + 1;
isrealA = 0;
}
}
}
if (!isrealA && issymA) /* A is complex but result is real */
{
/* result will be complex, realloc real part of A for real part inplace computation */
sciErr = allocArrayOfDouble(pvApiCtx, *getNbInputArgument(_pvCtx) + 1, ndimsA, dimsA, &ri);
if (sciErr.iErr)
{
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 0;
}
C2F(dcopy)(&lA, Ar, &one, ri, &one);
Ar = ri;
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(_pvCtx) + 1;
}
/* Set pointers on real and imaginary part of the input */
ri = Ar;
ii = Ai;
scale = None; /*no scaling needed */
if (isn == FFTW_BACKWARD) scale = Divide;
if (isrealA & !WITHMKL) /* To have type = C2C_PLAN*/
{
/*A is real */
if (issymA)
{
/*r2r = isrealA && issymA*/
/* there is no general plan able to compute r2r transform so it is tranformed into
a R2c plan. The computed imaginary part will be zero*/
sciErr = allocMatrixOfDouble(pvApiCtx, *getNbInputArgument(_pvCtx) + 1, 1, lA, &io);
if (sciErr.iErr)
{
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 0;
}
type = R2C_PLAN;
ro = Ar;
}
else
{
/*r2c = isrealA && ~issymA;*/
/* transform cannot be done in place */
sciErr = allocComplexArrayOfDouble(pvApiCtx, *getNbInputArgument(_pvCtx) + 1, ndimsA, dimsA, &ro, &io);
if (sciErr.iErr)
{
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 0;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(_pvCtx) + 1;
type = R2C_PLAN; /* fftw_plan_guru_split_dft_r2c plans for an FFTW_FORWARD transform*/
if (isn == FFTW_BACKWARD)
{
/*transform problem into a FORWARD fft*/
/*ifft(A)=conj(fft(A/N)) cas vect*/
/* pre traitement A must be divided by N cas vect*/
/* post treatment result must conjugated */
}
}
}
else
{
/* A is complex */
if (!WITHMKL && issymA) /*result is real*/
{
/*c2r = ~isrealA && issymA*/
ro = ri;
io = NULL;
type = C2R_PLAN; /*fftw_plan_guru_split_dft_c2r plans for an FFTW_BACKWARD transform*/
if (isn == FFTW_FORWARD)
{
/*transform problem into a BACKWARD fft : fft(A)=ifft(conj(A))*/
double minusone = -1.0;
C2F(dscal)(&lA, &minusone, ii, &one);
}
}
else
{
/*c2c = ~isrealA && ~issymA;*/
/* use inplace transform*/
isrealA = 0;
type = C2C_PLAN; /* fftw_plan_guru_split_dft plans for an FFTW_FORWARD transform*/
if (isn == FFTW_BACKWARD)
{
/*transform problem into a FORWARD fft*/
/* ifft(A) = %i*conj(fft(%i*conj(A)/N) */
/* reverse input */
ri = Ai;
ii = Ar;
/* reverse output */
ro = Ai;
io = Ar;
}
else
{
ro = ri;
io = ii;
}
}
}
/* pre-treatment */
if (scale != None)
{
double ak = 1.0;
for (i = 0; i < gdim.rank; i++) ak = ak * ((double)(gdim.dims[i].n));
if (scale == Divide) ak = 1.0 / ak;
C2F(dscal)(&lA, &ak, ri, &one);
if (isrealA == 0) C2F(dscal)(&lA, &ak, ii, &one);
}
if (!WITHMKL || gdim.howmany_rank <= 1)
{
/* Set Plan */
p = GetFFTWPlan(type, &gdim, ri, ii, ro, io, getCurrentFftwFlags(), isn , (fftw_r2r_kind *)NULL,&errflag);
if (errflag == 1)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
else if (errflag == 2)
{
Scierror(999, _("%s: Creation of requested fftw plan failed.\n"), fname);
return 0;
}
/* execute FFTW plan */
ExecuteFFTWPlan(type, p, ri, ii, ro, io);
}
else
{
/*FFTW MKL does not implement yet guru plan with howmany_rank>1 */
/* associated loops described in gdim.howmany_rank and gdim.howmany_dims */
/* are implemented here by a set of call with howmany_rank==1 */
fftw_iodim *howmany_dims = gdim.howmany_dims;
int howmany_rank = gdim.howmany_rank;
int i1 = 0, i2 = 0;
int nloop = 0;
int t = 0;
gdim.howmany_rank = 0;
gdim.howmany_dims = NULL;
p = GetFFTWPlan(type, &gdim, ri, ii, ro, io, getCurrentFftwFlags(), isn , (fftw_r2r_kind *)NULL,&errflag);
if (errflag == 1)
{
Scierror(999, _("%s: No more memory.\n"), fname);
FREE(dims1);
FREE(incr1);
return 0;
}
else if (errflag == 2)
{
Scierror(999, _("%s: Creation of requested fftw plan failed.\n"), fname);
FREE(dims1);
FREE(incr1);
return 0;
}
/* flatten nested loops: replace howmany_rank nested loops by a single one*/
/* Build temporary arrays used by flatened loop */
if ((dims1 = (int *)MALLOC(sizeof(int) * howmany_rank)) == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
FREE(dims1);
FREE(incr1);
return 0;
}
dims1[0] = howmany_dims[0].n;
for (i = 1; i < howmany_rank; i++) dims1[i] = dims1[i - 1] * howmany_dims[i].n;
nloop = dims1[howmany_rank - 1];
if ((incr1 = (int *)MALLOC(sizeof(int) * howmany_rank)) == NULL)
{
Scierror(999, _("%s: No more memory.\n"), fname);
FREE(dims1);
FREE(incr1);
return 0;
}
t = 1;
for (i = 0; i < howmany_rank; i++)
{
t += (howmany_dims[i].n - 1) * howmany_dims[i].is;
incr1[i] = t;
}
/*loop on each "plan" */
i = 0; /*index on the first plan entry */
for (i1 = 1; i1 <= nloop; i1++)
{
/* the input and output are assumed to be complex because
within MKL real cases are transformed to complex ones in
previous steps of sci_fft_gen*/
ExecuteFFTWPlan(type, p, &ri[i], &ii[i], &ro[i], &io[i]);
i += howmany_dims[0].is;
/* check if a loop ends*/
for (i2 = howmany_rank - 2; i2 >= 0; i2--)
{
if ((i1 % dims1[i2]) == 0)
{
/*loop on dimension i2 ends, compute jump on the first plan entry index*/
i += howmany_dims[i2 + 1].is - incr1[i2];
break;
}
}
}
/* free temporary arrays */
FREE(dims1);
FREE(incr1);
/* reset initial value of gdim for post treatment*/
gdim.howmany_rank = howmany_rank;
gdim.howmany_dims = howmany_dims;
}
/* Post treatment */
switch (type)
{
case R2R_PLAN:
if (complete_array(ro, NULL, gdim) == -1)
{
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 0;
}
break;
case C2R_PLAN:
break;
case R2C_PLAN:
if (issymA)
{
/*R2C has been used to solve an r2r problem*/
if (complete_array(ro, NULL, gdim) == -1)
{
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 0;
}
}
else
{
if (complete_array(ro, io, gdim) == -1)
{
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 0;
}
if (isn == FFTW_BACKWARD)
{
/*conjugate result */
double ak = -1.0;
C2F(dscal)(&lA, &ak, io, &one);
}
}
break;
case C2C_PLAN:
if (WITHMKL && isrealA_save)
{
if (isn == FFTW_FORWARD)
{
if (complete_array(ro, io, gdim) == -1)
{
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 0;
}
}
else
{
if (complete_array(io, ro, gdim) == -1)
{
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 0;
}
}
}
break;
}
return 1;
}
SciErr allocCommonMatrixOfDouble(void* _pvCtx, int _iVar, char _cType, int _iComplex, int _iRows, int _iCols, double** _pdblReal, double** _pdblImg)
{
SciErr sciErr = sciErrInit();
if (_pvCtx == NULL)
{
addErrorMessage(&sciErr, API_ERROR_INVALID_POINTER, _("%s: Invalid argument address"), _iComplex ? "allocComplexMatrixOfDouble" : "allocMatrixOfDouble");
return sciErr;
}
types::GatewayStruct* pStr = (types::GatewayStruct*)_pvCtx;
types::InternalType** out = pStr->m_pOut;
types::Double* pDbl = NULL;
try
{
if (_cType == 'z')
{
pDbl = new types::Double(_iRows, _iCols, _iComplex == 1, true);
}
else
{
pDbl = new types::Double(_iRows, _iCols, _iComplex == 1);
if (_cType == 'i')
{
pDbl->setViewAsInteger();
}
}
}
catch (const ast::InternalError& ie)
{
addErrorMessage(&sciErr, API_ERROR_NO_MORE_MEMORY, _("%s: %ls"), _iComplex ? "allocComplexMatrixOfDouble" : "allocMatrixOfDouble", ie.GetErrorMessage().c_str());
return sciErr;
}
if (pDbl == NULL)
{
addErrorMessage(&sciErr, API_ERROR_NO_MORE_MEMORY, _("%s: No more memory to allocate variable"), _iComplex ? "allocComplexMatrixOfDouble" : "allocMatrixOfDouble");
return sciErr;
}
int rhs = _iVar - *getNbInputArgument(_pvCtx);
out[rhs - 1] = pDbl;
*_pdblReal = pDbl->getReal();
if (*_pdblReal == NULL)
{
addErrorMessage(&sciErr, API_ERROR_NO_MORE_MEMORY, _("%s: No more memory to allocate variable"), _iComplex ? "allocComplexMatrixOfDouble" : "allocexMatrixOfDouble");
delete pDbl;
return sciErr;
}
if (_iComplex && _pdblImg != NULL)
{
*_pdblImg = pDbl->getImg();
if (*_pdblImg == NULL)
{
addErrorMessage(&sciErr, API_ERROR_NO_MORE_MEMORY, _("%s: No more memory to allocate variable"), _iComplex ? "allocComplexMatrixOfDouble" : "allocMatrixOfDouble");
delete pDbl;
return sciErr;
}
}
return sciErr;
}
