/*--------------------------------------------------------------------------*/ 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; }
/*--------------------------------------------------------------------------*/ int sci_fftw_flags(char *fname, unsigned long fname_len) { /* declaration of variables to store scilab parameters address */ static int m1 = 0, n1 = 0; char **Str1 = NULL; char **Str3 = NULL; unsigned int uiVar1 = 0; int* piDataOut = NULL; int* piAddr1 = NULL; int* piLen = NULL; int iType = 0; /* please update me ! */ static int nb_flag = 22; static char *Str[] = { /* documented flags */ "FFTW_MEASURE", "FFTW_DESTROY_INPUT", "FFTW_UNALIGNED", "FFTW_CONSERVE_MEMORY", "FFTW_EXHAUSTIVE", "FFTW_PRESERVE_INPUT", "FFTW_PATIENT", "FFTW_ESTIMATE", /* undocumented beyond-guru flags */ "FFTW_ESTIMATE_PATIENT", "FFTW_BELIEVE_PCOST", "FFTW_NO_DFT_R2HC", "FFTW_NO_NONTHREADED", "FFTW_NO_BUFFERING", "FFTW_NO_INDIRECT_OP", "FFTW_ALLOW_LARGE_GENERIC", "FFTW_NO_RANK_SPLITS", "FFTW_NO_VRANK_SPLITS", "FFTW_NO_VRECURSE", "FFTW_NO_SIMD", "FFTW_NO_SLOW", "FFTW_NO_FIXED_RADIX_LARGE_N", "FFTW_ALLOW_PRUNING" }; static unsigned flagt[] = { /* documented flags */ FFTW_MEASURE, FFTW_DESTROY_INPUT, FFTW_UNALIGNED, FFTW_CONSERVE_MEMORY, FFTW_EXHAUSTIVE, FFTW_PRESERVE_INPUT, FFTW_PATIENT, FFTW_ESTIMATE, /* undocumented beyond-guru flags */ FFTW_ESTIMATE_PATIENT, FFTW_BELIEVE_PCOST, FFTW_NO_DFT_R2HC, FFTW_NO_NONTHREADED, FFTW_NO_BUFFERING, FFTW_NO_INDIRECT_OP, FFTW_ALLOW_LARGE_GENERIC, FFTW_NO_RANK_SPLITS, FFTW_NO_VRANK_SPLITS, FFTW_NO_VRECURSE, FFTW_NO_SIMD, FFTW_NO_SLOW, FFTW_NO_FIXED_RADIX_LARGE_N, FFTW_ALLOW_PRUNING }; unsigned flagv = 0; int i = 0, j = 0; SciErr sciErr; CheckInputArgument(pvApiCtx, 0, 1); if (nbInputArgument(pvApiCtx) == 0) { // nothing } else { //get variable address of the input argument sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1); if (sciErr.iErr) { printError(&sciErr, 0); return 1; } getVarType(pvApiCtx, piAddr1, &iType); switch (iType) { case sci_ints: { /* int */ int iPrecision = 0; int* pi32Data = NULL; unsigned int* pui32Data = NULL; getMatrixOfIntegerPrecision(pvApiCtx, piAddr1, &iPrecision); if (iPrecision != SCI_INT32 && iPrecision != SCI_UINT32) { Scierror(999, _("%s: Wrong type for input argument #%d: A int32 expected.\n"), fname, 1); return 1; } if (iPrecision == SCI_INT32) { sciErr = getMatrixOfInteger32(pvApiCtx, piAddr1, &m1, &n1, pi32Data); uiVar1 = (unsigned int)pi32Data[0]; } else { sciErr = getMatrixOfUnsignedInteger32(pvApiCtx, piAddr1, &m1, &n1, pui32Data); uiVar1 = pui32Data[0]; } if (sciErr.iErr) { Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1); printError(&sciErr, 0); return 1; } break; } case sci_matrix: { /* double */ double* pdblData = NULL; sciErr = getMatrixOfDouble(pvApiCtx, piAddr1, &m1, &n1, &pdblData); if (sciErr.iErr) { Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1); printError(&sciErr, 0); return 1; } uiVar1 = (unsigned int)pdblData[0]; break; } case sci_strings: { /* string */ //fisrt call to retrieve dimensions sciErr = getMatrixOfString(pvApiCtx, piAddr1, &m1, &n1, NULL, NULL); if (sciErr.iErr) { printError(&sciErr, 0); return 1; } piLen = (int*)malloc(sizeof(int) * m1 * n1); //second call to retrieve length of each string sciErr = getMatrixOfString(pvApiCtx, piAddr1, &m1, &n1, piLen, NULL); if (sciErr.iErr) { 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++) { for (i = 0; i < nb_flag; i++) { if (strcmp(Str1[j], Str[i]) == 0) { break; } } if (i == nb_flag) { freeArrayOfString(Str1, m1 * n1); Scierror(999, _("%s: Wrong values for input argument #%d: FFTW flag expected.\n"), fname, 1); return 0; } else { if (i > 0) { flagv = ( flagv | (1U << (i - 1)) ); } } } uiVar1 = (unsigned int)flagv; freeArrayOfString(Str1, m1 * n1); m1 = 1; n1 = 1; break; } default: Scierror(53, _("%s: Wrong type for input argument #%d.\n"), fname, 1); return 1; } CheckDims(1, m1, n1, 1, 1); setCurrentFftwFlags(uiVar1); } /* return value of Sci_Plan.flags in position 2 */ sciErr = allocMatrixOfInteger32(pvApiCtx, nbInputArgument(pvApiCtx) + 2, 1, 1, &piDataOut); if (sciErr.iErr) { printError(&sciErr, 0); Scierror(999, _("%s: No more memory.\n"), fname); return 1; } piDataOut[0] = (int) getCurrentFftwFlags(); /*Test for only FFTW_MEASURE*/ if (getCurrentFftwFlags() == 0) { j = 1; if ((Str3 = (char **)MALLOC(sizeof(char *))) == NULL) { Scierror(999, _("%s: No more memory.\n"), fname); return 1; } Str3[0] = strdup(Str[0]); if (Str3[0] == NULL) { Scierror(999, _("%s: No more memory.\n"), fname); return 1; } } else { j = 0; for (i = 1; i < nb_flag; i++) { if ((getCurrentFftwFlags() & flagt[i]) == flagt[i]) { j++; if (Str3) { Str3 = (char **)REALLOC(Str3, sizeof(char *) * j); } else { Str3 = (char **)MALLOC(sizeof(char *) * j); } if ( Str3 == NULL) { Scierror(999, _("%s: No more memory.\n"), fname); return 1; } Str3[j - 1] = strdup(Str[i]); if (Str3[j - 1] == NULL) { freeArrayOfString(Str3, j); Scierror(999, _("%s: No more memory.\n"), fname); return 1; } } } } /* Create the string matrix as return of the function */ sciErr = createMatrixOfString(pvApiCtx, nbInputArgument(pvApiCtx) + 3, j, 1, Str3); freeArrayOfString(Str3, j); // Data have been copied into Scilab memory if (sciErr.iErr) { freeArrayOfString(Str3, j); // Make sure everything is cleanup in case of error printError(&sciErr, 0); return 1; } AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 2; AssignOutputVariable(pvApiCtx, 2) = nbInputArgument(pvApiCtx) + 3; ReturnArguments(pvApiCtx); return 0; }
/*--------------------------------------------------------------------------*/ int sci_fftw_flags(char *fname, unsigned long fname_len) { /* declaration of variables to store scilab parameters address */ static int l1 = 0, m1 = 0, n1 = 0; SciIntMat M1; char **Str1 = NULL; static int l2 = 0, m2 = 0, n2 = 0; char **Str3 = NULL; /* please update me ! */ static int nb_flag = 22; static char *Str[] = { /* documented flags */ "FFTW_MEASURE", "FFTW_DESTROY_INPUT", "FFTW_UNALIGNED", "FFTW_CONSERVE_MEMORY", "FFTW_EXHAUSTIVE", "FFTW_PRESERVE_INPUT", "FFTW_PATIENT", "FFTW_ESTIMATE", /* undocumented beyond-guru flags */ "FFTW_ESTIMATE_PATIENT", "FFTW_BELIEVE_PCOST", "FFTW_NO_DFT_R2HC", "FFTW_NO_NONTHREADED", "FFTW_NO_BUFFERING", "FFTW_NO_INDIRECT_OP", "FFTW_ALLOW_LARGE_GENERIC", "FFTW_NO_RANK_SPLITS", "FFTW_NO_VRANK_SPLITS", "FFTW_NO_VRECURSE", "FFTW_NO_SIMD", "FFTW_NO_SLOW", "FFTW_NO_FIXED_RADIX_LARGE_N", "FFTW_ALLOW_PRUNING" }; static unsigned flagt[] = { /* documented flags */ FFTW_MEASURE, FFTW_DESTROY_INPUT, FFTW_UNALIGNED, FFTW_CONSERVE_MEMORY, FFTW_EXHAUSTIVE, FFTW_PRESERVE_INPUT, FFTW_PATIENT, FFTW_ESTIMATE, /* undocumented beyond-guru flags */ FFTW_ESTIMATE_PATIENT, FFTW_BELIEVE_PCOST, FFTW_NO_DFT_R2HC, FFTW_NO_NONTHREADED, FFTW_NO_BUFFERING, FFTW_NO_INDIRECT_OP, FFTW_ALLOW_LARGE_GENERIC, FFTW_NO_RANK_SPLITS, FFTW_NO_VRANK_SPLITS, FFTW_NO_VRECURSE, FFTW_NO_SIMD, FFTW_NO_SLOW, FFTW_NO_FIXED_RADIX_LARGE_N, FFTW_ALLOW_PRUNING }; unsigned flagv = 0; int i = 0, j = 0; CheckRhs(0, 1); if (Rhs == 0) { // nothing } else { switch(VarType(1)) { case sci_ints: /* int */ GetRhsVar(1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m1, &n1, &M1); CheckDims(1, m1, n1, 1, 1); setCurrentFftwFlags(((int *)M1.D)[0]); break; case sci_matrix: /* double */ GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1); CheckDims(1, m1, n1, 1, 1); setCurrentFftwFlags((int)*stk(l1)); break; case sci_strings: /* string */ GetRhsVar(1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Str1); for (j = 0; j < m1 * n1; j++) { for (i = 0; i < nb_flag; i++) { if (strcmp(Str1[j], Str[i]) == 0) break; } if (i == nb_flag) { freeArrayOfString(Str1, m1 * n1); Scierror(999, _("%s: Wrong values for input argument #%d: FFTW flag expected.\n"), fname, 1); return 0; } else { if (i > 0) { flagv = ( flagv | (1U << (i - 1)) ); } } } setCurrentFftwFlags(flagv); freeArrayOfString(Str1, m1 * n1); break; default: Scierror(53, _("%s: Wrong type for input argument #%d.\n"), fname, 1); return 0; } } /* return value of Sci_Plan.flags in position 2 */ m2 = 1; n2 = m2; l2 = I_INT32; CreateVar(Rhs + 2, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m2, &n2, &l2); *istk(l2) = (int) getCurrentFftwFlags(); /*Test for only FFTW_MEASURE*/ if (getCurrentFftwFlags() == 0) { j = 1; if ((Str3 = (char **)MALLOC(sizeof(char *))) == NULL) { Scierror(999, _("%s: No more memory.\n"), fname); return 0; } Str3[0] = strdup(Str[0]); if (Str3[0] == NULL) { Scierror(999, _("%s: No more memory.\n"), fname); return 0; } } else { j = 0; for (i = 1;i < nb_flag; i++) { if((getCurrentFftwFlags() & flagt[i]) == flagt[i]) { j++; if (Str3) { Str3 = (char **)REALLOC(Str3,sizeof(char *) * j); } else { Str3 = (char **)MALLOC(sizeof(char *) * j); } if ( Str3 == NULL) { Scierror(999, _("%s: No more memory.\n"), fname); return 0; } Str3[j - 1] = strdup(Str[i]); if (Str3[j - 1] == NULL) { freeArrayOfString(Str3, j); Scierror(999, _("%s: No more memory.\n"), fname); return 0; } } } } n1 = 1; CreateVarFromPtr(Rhs + 3, MATRIX_OF_STRING_DATATYPE, &j, &n1, Str3); freeArrayOfString(Str3, j); LhsVar(1) = Rhs + 2; LhsVar(2) = Rhs + 3; PutLhsVar(); return 0; }