/* Set fftw wisdom
*
* Scilab Syntax :
* -->set_fftw_wisdom(txt);
*
* Input : a scilab string matrix
*
* Output : Nothing or an error messsage if
* wisdom can't be read by fftw
*
*/
int sci_set_fftw_wisdom(char *fname, void* pvApiCtx)
{
SciErr sciErr;
char **Str1 = NULL;
char *Str = NULL;
int m1 = 0, n1 = 0;
int len = 0, k = 0;
int j = 0;
int i = 0;
int* piAddr1 = NULL;
int* piLen = NULL;
if (withMKL())
{
Scierror(999, _("%s: MKL fftw library does not implement wisdom functions yet.\n"), fname);
return 0;
}
CheckInputArgument(pvApiCtx, 1, 1);
//get variable address
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isStringType(pvApiCtx, piAddr1) == 0)
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, 1);
return 1;
}
//fisrt call to retrieve dimensions
sciErr = getMatrixOfString(pvApiCtx, piAddr1, &m1, &n1, NULL, NULL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
piLen = (int*)MALLOC(sizeof(int) * m1 * n1);
//second call to retrieve length of each string
sciErr = getMatrixOfString(pvApiCtx, piAddr1, &m1, &n1, piLen, NULL);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
Str1 = (char**)MALLOC(sizeof(char*) * m1 * n1);
for (i = 0 ; i < m1 * n1 ; i++)
{
Str1[i] = (char*)MALLOC(sizeof(char) * (piLen[i] + 1));//+ 1 for null termination
}
//third call to retrieve data
sciErr = getMatrixOfString(pvApiCtx, piAddr1, &m1, &n1, piLen, Str1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
for (j = 0; j < m1 * n1; j++)
{
len += (int)strlen(Str1[j]) + 1;
if (Str)
{
Str = (char *)REALLOC(Str, sizeof(char) * (len));
}
else
{
Str = (char *)MALLOC(sizeof(char) * (len));
}
if (Str == NULL)
{
freeArrayOfString(Str1, m1 * n1);
Scierror(999, _("%s: Cannot allocate more memory.\n"), fname);
return 1;
}
for (i = 0; i < (int)strlen(Str1[j]); i++)
{
Str[k + i] = Str1[j][i];
}
Str[k + strlen(Str1[j])] = '\n';
k += (int)strlen(Str1[j]) + 1;
}
Str[k - 1] = '\0';
freeArrayOfString(Str1, m1 * n1);
if (!(call_fftw_import_wisdom_from_string(Str)))
{
FREE(Str);
Str = NULL;
Scierror(999, _("%s: Wrong value for input argument #%d: a valid wisdom expected.\n"), fname, 1);
return 1;
}
FREE(Str);
Str = NULL;
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
/* fftw function.
*
* Scilab Calling sequence :
* fftw(A [,option])
* fftw(A,sign [,option])
* fftw(A,sel,sign [,option])
* fftw(A,sign,dim,incr [,option])
*
* Input : A : a scilab double complex or real vector, matrix or hypermatrix
*
* sign : a scilab double or integer scalar (-1 or 1): the sign
* in the exponential component
*
* sel : a scilab double or integer vector, the selection of dimensions
* dim : a scilab double or integer vector: the dimensions
* of the Fast Fourier Transform to perform
*
* incr : a scilab double or integer vector: the increments
* of the Fast Fourier Transform to perform
*
* Output : a scilab double complex or real array with same shape as A that
* gives the result of the transform.
*
*/
int sci_fftw(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int *piAddr = NULL;
char *option = NULL;
int iopt = 0; /* automatic r2c or c2r transform use decision */
int rhs = Rhs;
int iTypeOne = 0;
int ndimsA = 0;
int *dimsA = NULL;
double *Ar = NULL, *Ai = NULL;
int isn = FFTW_FORWARD;
WITHMKL = withMKL();
/****************************************
* Basic constraints on rhs arguments *
****************************************/
/* check min/max lhs/rhs arguments of scilab function */
CheckInputArgument(pvApiCtx, 1, 5);
CheckOutputArgument(pvApiCtx, 1, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddr, &iTypeOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
if ((iTypeOne == sci_list) || (iTypeOne == sci_tlist))
{
OverLoad(1);
return 1;
}
if (iTypeOne == sci_mlist)
{
/* We allow overload for not hypermatrix type */
if (!isHyperMatrixMlist(pvApiCtx, piAddr))
{
OverLoad(1);
return 1;
}
}
/* checking if last argument is a potential option argument (character string) */
sciErr = getVarAddressFromPosition(pvApiCtx, Rhs, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, Rhs);
return 1;
}
if (isStringType(pvApiCtx, piAddr)) /* fftw(...,option); */
{
if (isScalar(pvApiCtx, piAddr))
{
if (getAllocatedSingleString(pvApiCtx, piAddr, &option) == 0)
{
if (strcmp("symmetric", option) == 0) iopt = 1; /*user assumes symmetry */
else if (strcmp("nonsymmetric", option) == 0) iopt = 2; /*user claims full transform */
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), fname, Rhs, "\"symmetric\"", "\"nonsymmetric\"");
freeAllocatedSingleString(option);
option = NULL;
return 1;
}
freeAllocatedSingleString(option);
option = NULL;
rhs = Rhs - 1;
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' or '%s' expected.\n"), fname, Rhs, "\"symmetric\"", "\"nonsymmetric\"");
return 1;
}
}
}
/******************** Checking if isn is given ************************************************/
if (rhs == 1) /*only one rhs argument: forward fft*/
{
isn = FFTW_FORWARD; /* default value */
}
else /*get isn out of second argument*/
{
sciErr = getScalarIntArg(pvApiCtx, 2, fname, &isn);
if (sciErr.iErr)
{
Scierror(sciErr.iErr, getErrorMessage(sciErr));
return 1;
}
/* check value of second rhs argument */
if ((isn != FFTW_FORWARD) && (isn != FFTW_BACKWARD))
{
Scierror(53, _("%s: Wrong value for input argument #%d: %d or %d expected.\n"), fname, 2, FFTW_FORWARD, FFTW_BACKWARD);
return 1;
}
}
/******************** getting the array A ************************************************/
getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (!getArrayOfDouble(pvApiCtx, piAddr, &ndimsA, &dimsA, &Ar, &Ai))
{
Scierror(999, _("%s: Wrong type for argument #%d: Array of floating point numbers expected.\n"), fname, 1);
return 1;
}
/******************** Select proper method ************************************************/
if (rhs < 3)
{
/* fftw(A ,sign [,option])*/
sci_fft_2args(pvApiCtx, fname, ndimsA, dimsA, Ar, Ai, isn, iopt);
}
else if (rhs == 3)
{
/* fftw(A ,sign ,sel [,option])*/
sci_fft_3args(pvApiCtx, fname, ndimsA, dimsA, Ar, Ai, isn, iopt);
}
else if (rhs == 4)
{
/* fftw(A ,sign ,dim,incr [option])*/
sci_fft_4args(pvApiCtx, fname, ndimsA, dimsA, Ar, Ai, isn, iopt);
}
return 0;
}
