int gw_action_binding()
{
Scierror(999, _("Scilab '%s' module not installed.\n"), "action_binding");
return 0;
}
/*--------------------------------------------------------------------------*/
int C2F(sci_who)(char *fname,unsigned long fname_len)
{
static int l1,n1,m1;
struct VariableStruct *GlobalVariables = NULL;
struct VariableStruct *LocalVariables = NULL;
int NbrVarsGlobal=0;
int NbrVarsLocal=0;
Rhs=Max(0,Rhs);
CheckRhs(0,2);
CheckLhs(0,2);
SetVariablesStructs(&GlobalVariables,&NbrVarsGlobal,&LocalVariables,&NbrVarsLocal);
if (Rhs == 0) /* who() */
{
NoRhs(GlobalVariables,NbrVarsGlobal,LocalVariables,NbrVarsLocal,FALSE);
}
else
if (Rhs == 1) /* who('get') or who('global') or who('sorted')*/
{
if (GetType(1) == sci_strings)
{
char *Param1String=NULL;
GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
Param1String=cstk(l1);
if ( (strcmp(Param1String,"get")==0) ||
(strcmp(Param1String,"local")==0) ||
(strcmp(Param1String,"global")==0) ||
(strcmp(Param1String,"sorted")==0) )
{
if (strcmp(Param1String,"sorted")==0)
{
NoRhs(GlobalVariables,NbrVarsGlobal,LocalVariables,NbrVarsLocal,TRUE);
}
else
if (strcmp(Param1String,"global")==0)
{
if (Lhs == 1)
{
OneLhs(GlobalVariables,NbrVarsGlobal,FALSE);
}
else /* Lhs == 2 */
{
TwoLhs(GlobalVariables,NbrVarsGlobal,FALSE);
}
}
else /* get or local */
{
if (Lhs == 1)
{
OneLhs(LocalVariables,NbrVarsLocal,FALSE);
}
else /* Lhs == 2 */
{
TwoLhs(LocalVariables,NbrVarsLocal,FALSE);
}
}
}
else
{
FreeVariableStructArray(GlobalVariables,NbrVarsGlobal);
FreeVariableStructArray(LocalVariables,NbrVarsLocal);
Scierror(999,_("%s: Wrong value for input argument #%d: '%s', '%s', '%s' or '%s' expected.\n"),fname, 1, "local" , "get" , "global", "sorted");
return 0;
}
}
else
{
FreeVariableStructArray(GlobalVariables,NbrVarsGlobal);
FreeVariableStructArray(LocalVariables,NbrVarsLocal);
Scierror(999,_("%s: Wrong value for input argument #%d: '%s', '%s', '%s' or '%s'.\n"),fname, 1, "local", "get", "global", "sorted");
return 0;
}
}
else
if (Rhs == 2) /* who('get','sorted') or who('global','sorted') */
{
if ( (GetType(1) == sci_strings) && (GetType(2) == sci_strings) )
{
char *Param1String=NULL;
char *Param2String=NULL;
GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
Param1String=cstk(l1);
GetRhsVar(2,STRING_DATATYPE,&m1,&n1,&l1);
Param2String=cstk(l1);
if (strcmp(Param2String,"sorted"))
{
FreeVariableStructArray(GlobalVariables,NbrVarsGlobal);
FreeVariableStructArray(LocalVariables,NbrVarsLocal);
Scierror(999,_("%s: Wrong value for input argument #%d: '%s' expected.\n"),fname, 2, "sorted");
return 0;
}
else
{
if ( (strcmp(Param1String,"get")==0) ||
(strcmp(Param1String,"local")==0) ||
(strcmp(Param1String,"global")==0) )
{
if (strcmp(Param1String,"global")==0)
{
if (Lhs == 1)
{
OneLhs(GlobalVariables,NbrVarsGlobal,TRUE);
}
else /* Lhs == 2 */
{
TwoLhs(GlobalVariables,NbrVarsGlobal,TRUE);
}
}
else /* get or local */
{
if (Lhs == 1)
{
OneLhs(LocalVariables,NbrVarsLocal,TRUE);
}
else /* Lhs == 2 */
{
TwoLhs(LocalVariables,NbrVarsLocal,TRUE);
}
}
}
else
{
FreeVariableStructArray(GlobalVariables,NbrVarsGlobal);
FreeVariableStructArray(LocalVariables,NbrVarsLocal);
Scierror(999,_("%s: Wrong value for input argument #%d: '%s', '%s' or '%s'.\n"),fname,1,"local","get","global");
return 0;
}
}
}
else
{
FreeVariableStructArray(GlobalVariables,NbrVarsGlobal);
FreeVariableStructArray(LocalVariables,NbrVarsLocal);
Scierror(999,_("%s: Wrong value for input argument #%d: '%s', '%s', '%s' expected. Input argument #%d must be '%s'.\n"),fname,1, "local","get","global","sorted");
return 0;
}
}
FreeVariableStructArray(GlobalVariables,NbrVarsGlobal);
FreeVariableStructArray(LocalVariables,NbrVarsLocal);
return 0;
}
/* setgrayplot(pobj,cstk(l2), &l3, &numrow3, &numcol3, fname) */
int setgrayplotdata( char* pobjUID, AssignedList * tlist )
{
BOOL result;
int nbRow[3];
int nbCol[3];
int gridSize[4];
double * pvecx = NULL;
double * pvecy = NULL;
double * pvecz = NULL;
pvecx = getDoubleMatrixFromList(tlist, 2, &nbRow[0], &nbCol[0]);
pvecy = getDoubleMatrixFromList(tlist, 3, &nbRow[1], &nbCol[1]);
pvecz = getDoubleMatrixFromList(tlist, 4, &nbRow[2], &nbCol[2]);
if ( nbCol[0] != 1 || nbCol[1] != 1 )
{
Scierror(999, _("%s: Wrong type for argument #%d: Columns vectors expected.\n"),"Tlist",1);
return SET_PROPERTY_ERROR;
}
if ( nbRow[2] != nbRow[0] || nbCol[2] != nbRow[1] )
{
Scierror(999, _("%s: Wrong size for arguments #%d: Incompatible length.\n"),"Tlist",3);
/* Was previously: */
#if 0
Scierror(999, _("%s: Wrong size for arguments #%d: Incompatible length.\n"),"Tlist","Tlist",3);
#endif
return 0;
}
if ( nbRow[0] * nbCol[0] == 0 || nbRow[1] * nbCol[1] == 0 || nbRow[2] * nbCol[2] == 0 )
{
return sciReturnEmptyMatrix();
}
/*
* Update the x and y vectors dimensions
* These vectors are column ones
*/
gridSize[0] = nbRow[0];
gridSize[1] = 1;
gridSize[2] = nbRow[1];
gridSize[3] = 1;
/* Resizes the coordinates arrays if required */
result = setGraphicObjectProperty(pobjUID, __GO_DATA_MODEL_GRID_SIZE__, gridSize, jni_int_vector, 4);
if (result == FALSE)
{
Scierror(999, _("%s: No more memory.\n"), "setgrayplotdata");
return SET_PROPERTY_ERROR;
}
setGraphicObjectProperty(pobjUID, __GO_DATA_MODEL_X__, pvecx, jni_double_vector, nbRow[0]);
setGraphicObjectProperty(pobjUID, __GO_DATA_MODEL_Y__, pvecy, jni_double_vector, nbRow[1]);
setGraphicObjectProperty(pobjUID, __GO_DATA_MODEL_Z__, pvecz, jni_double_vector, nbRow[2]*nbCol[2]);
return SET_PROPERTY_SUCCEED;
}
/* ==================================================================== */
int sci_edf_set_digital_minimum(char *fname)
{
SciErr sciErr;
int m1 = 0, n1 = 0;
int *piAddressVarOne = NULL;
int* piLenVarOne = NULL;
double *pdVarOne = NULL;
int iType1 = 0;
int m2 = 0, n2 = 0;
int *piAddressVarTwo = NULL;
double *pdVarTwo = NULL;
int iType2 = 0;
int m3 = 0, n3 = 0;
int *piAddressVarThree = NULL;
double *pdVarThree = NULL;
int iType3 = 0;
int m_out = 0, n_out = 0;
double *dOut = NULL;
int i;
int handle;
/* --> result = csum(3,8)
/* check that we have only 2 parameters input */
/* check that we have only 1 parameters output */
CheckInputArgument(pvApiCtx,3,3) ;
CheckOutputArgument(pvApiCtx,1,1) ;
/* get Address of inputs */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddressVarThree);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
/* check input type */
sciErr = getVarType(pvApiCtx, piAddressVarOne, &iType1);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if ( iType1 != sci_matrix )
{
Scierror(999,"%s: Wrong type for input argument #%d: A integer expected.\n",fname,1);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarTwo, &iType2);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if ( iType2 != sci_matrix )
{
Scierror(999,"%s: Wrong type for input argument #%d: A double expected.\n",fname,2);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarThree, &iType3);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if ( iType3 != sci_matrix )
{
Scierror(999,"%s: Wrong type for input argument #%d: A double expected.\n",fname,3);
return 0;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne,&m1,&n1,&pdVarOne);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo,&m2,&n2,&pdVarTwo);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarThree,&m3,&n3,&pdVarThree);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
/* check size */
if ( (m1 != 1) || (n1 != 1) )
{
Scierror(999,"%s: Wrong size for input argument #%d: A scalar expected.\n",fname,1);
return 0;
}
if ( (m2 !=1) || (n2 !=1) )
{
Scierror(999,"%s: Wrong size for input argument #%d: A scalar expected.\n",fname,2);
return 0;
}
if ( (m3 !=1) || (n3 !=1) )
{
Scierror(999,"%s: Wrong size for input argument #%d: A scalar expected.\n",fname,2);
return 0;
}
if ((int)pdVarTwo[0]<1){
Scierror(999,"The parameter edfsignal must be at least 1 !\n");
return 0;
}
/* call c function csum */
// csum(&pdVarOne[0],&pdVarTwo[0],&dOut);
if ( edf_set_digital_minimum((int)pdVarOne[0], (int)pdVarTwo[0]-1 , pdVarThree[0]) <0)
{
Scierror(999,"Could not write digital minimum\n");
return 0;
}
m_out = 1; n_out = 1;
dOut = (double*)malloc(sizeof(double) * m_out*n_out);
// CreateVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m_out, &n_out, &dout);
dOut[0]=0;
/* create result on stack */
createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, m_out, n_out, dOut);
free(dOut);
AssignOutputVariable(pvApiCtx,1) = nbInputArgument(pvApiCtx) + 1;
/* This function put on scilab stack, the lhs variable
which are at the position lhs(i) on calling stack */
/* You need to add PutLhsVar here because WITHOUT_ADD_PUTLHSVAR
was defined and equal to %t */
/* without this, you do not need to add PutLhsVar here */
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_mputstr(char *fname, unsigned long fname_len)
{
int m1 = 0, n1 = 0, l1 = 0;
int m2 = 0, n2 = 0, l2 = 0;
int l3 = 0;
int err = 0;
int one = 1;
int fd = ALL_FILES_DESCRIPTOR;
Nbvars = 0 ;
CheckRhs(1, 2);
CheckLhs(1, 1);
/* checking variable file */
if (GetType(1) == sci_strings)
{
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 1);
return 0;
}
if ( Rhs >= 2)
{
if (GetType(2) == sci_matrix)
{
GetRhsVar(2, MATRIX_OF_INTEGER_DATATYPE, &m2, &n2, &l2);
if (m2*n2 == 1)
{
fd = *istk(l2);
}
else
{
Scierror(999, _("%s: Wrong size for input argument #%d: An integer expected.\n"), fname, 2);
return 0;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer expected.\n"), fname, 2);
return 0;
}
}
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &one, &one, &l3);
C2F(mputstr)(&fd, cstk(l1), stk(l3), &err);
if (err > 0)
{
SciError(10000);
return 0;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int get_logflags_arg(char *fname,int pos,rhs_opts opts[], char ** logFlags )
{
int m,n,l,first_opt=FirstOpt(),kopt;
if (pos < first_opt) /* regular argument */
{
if (VarType(pos))
{
GetRhsVar(pos,STRING_DATATYPE, &m, &n, &l);
if ((m * n != 2)&&(m * n != 3))
{
Scierror(999,"%s: Wrong size for input argument #%d: %d or %d expected\n",fname, pos, 2, 3);
return 0;
}
if (m * n == 2)
{
if ((*cstk(l)!='l'&&*cstk(l)!='n')||(*cstk(l+1)!='l'&&*cstk(l+1)!='n'))
{
Err=pos;
SciError(116);
return 0;
}
logFlagsCpy[0]='g';
logFlagsCpy[1]=*cstk(l);
logFlagsCpy[2]=*cstk(l+1) ;
*logFlags = logFlagsCpy ;
}
else
{
if (((*cstk(l)!='g')&&(*cstk(l)!='e')&&(*cstk(l)!='o')) ||
(*cstk(l+1)!='l'&&*cstk(l+1)!='n') ||
(*cstk(l+2)!='l'&&*cstk(l+2)!='n'))
{
Err=pos;
SciError(116);
return 0;
}
*logFlags = cstk(l) ;
}
}
else /* zero type argument --> default value */
{
*logFlags = getDefLogFlags() ;
}
}
else if ((kopt=FindOpt("logflag",opts)))
{ /* named argument: style=value */
GetRhsVar(kopt,STRING_DATATYPE, &m, &n, &l);
if ((m * n != 2)&&(m * n != 3))
{
Scierror(999,"%s: Wrong size for input argument #%d: %d or %d expected\n",fname, kopt, 2, 3);
return 0;
}
if (m * n == 2)
{
if ((*cstk(l)!='l'&&*cstk(l)!='n')||(*cstk(l+1)!='l'&&*cstk(l+1)!='n'))
{
Err=kopt;
SciError(116);
return 0;
}
logFlagsCpy[0]='g';
logFlagsCpy[1]=*cstk(l);
logFlagsCpy[2]=*cstk(l+1) ;
*logFlags = logFlagsCpy ;
}
else
{
if (((*cstk(l)!='g')&&(*cstk(l)!='e')&&(*cstk(l)!='o')) ||
(*cstk(l+1)!='l'&&*cstk(l+1)!='n') ||
(*cstk(l+2)!='l'&&*cstk(l+2)!='n'))
{
Err=kopt;
SciError(116);
return 0;
}
*logFlags = cstk(l) ;
}
}
else /* unspecified argument --> default value */
{
*logFlags = getDefLogFlags() ;
}
return 1;
}
/*--------------------------------------------------------------------------*/
int sci_callblk(char *fname, unsigned long fname_len)
{
/* auxilary variables -dimension and address-
* for scilab stack variables
*/
int *il1 = NULL;
int m1 = 0, n1 = 0;
int *il2_1 = NULL;
int m2_1 = 0, n2_1 = 0;
int *il2 = NULL;
int m2 = 0, n2 = 0;
int *il3 = NULL;
int m3 = 0, n3 = 0;
/* local variable */
int len_str = 0;
char *str = NULL;
int ierr = 0, ret = 0;
int j = 0;
int TopSave = 0;
int l_tmp = 0;
/* length of the scilab list scicos struct */
int nblklst = 41;
/* variable for callf */
scicos_flag flag = 0;
double t = 0.;
scicos_block Block;
memset(&Block, 0, sizeof(scicos_block));
/* check number of rhs/lhs param */
CheckRhs(3, 3);
CheckLhs(1, 1);
/* check rhs 1 (input scilab structure) */
il1 = (int *) GetData(1);
m1 = il1[1];
n1 = il1[2];
if (il1[0] != 16)
{
Scierror(888, _("%s : First argument must be a scicos_block typed list.\n"), fname);
return 0;
}
il2_1 = (int *) (listentry(il1, 1));
m2_1 = il2_1[1];
n2_1 = il2_1[2];
if ((il2_1[0] != 10) || ((m2_1 * n2_1) != nblklst))
{
Scierror(888, _("%s : First argument must be a valid scicos_block typed list.\n"), fname);
return 0;
}
len_str = il2_1[5] - 1;
if (len_str != 0)
{
if ((str = (char *) MALLOC((len_str + 1) * sizeof(char))) == NULL)
{
Scierror(888, _("%s: Memory allocation error.\n"), fname);
return 0;
}
str[len_str] = '\0';
C2F(cvstr)(&len_str, &il2_1[5 + nblklst], str, (j = 1, &j), len_str);
ret = strcmp("scicos_block", str);
FREE(str);
if (ret != 0)
{
Scierror(888, _("%s : First argument must be a valid scicos_block typed list.\n"), fname);
return 0;
}
}
else
{
Scierror(888, _("%s : First argument must be a valid scicos_block typed list.\n"), fname);
return 0;
}
/* convert scilab scicos struct to a C scicos struct */
ret = extractblklist(il1, &Block, &ierr);
/* error table */
switch (ierr)
{
case -39 :
Scierror(888, _("%s: Memory allocation error.\n"), fname);
break;
case 98 :
Scierror(888, _("%s : First argument must be a valid scicos_block typed list.\n"), fname);
break;
default:
break;
}
if (ierr != 0)
{
FREE(Block.z);
FREE(Block.ozsz);
FREE(Block.oztyp);
for (j = 0; j < Block.noz; j++)
{
FREE(Block.ozptr[j]);
}
FREE(Block.ozptr);
FREE(Block.x);
FREE(Block.xd);
FREE(Block.xprop);
FREE(Block.res);
FREE(Block.insz);
for (j = 0; j < Block.nin; j++)
{
FREE(Block.inptr[j]);
}
FREE(Block.inptr);
FREE(Block.outsz);
for (j = 0; j < Block.nout; j++)
{
FREE(Block.outptr[j]);
}
FREE(Block.outptr);
FREE(Block.evout);
FREE(Block.rpar);
FREE(Block.ipar);
FREE(Block.oparsz);
FREE(Block.opartyp);
for (j = 0; j < Block.nopar; j++)
{
FREE(Block.oparptr[j]);
}
FREE(Block.oparptr);
FREE(Block.g);
FREE(Block.jroot);
if (strlen(Block.label) != 0)
{
FREE(Block.label);
}
FREE(Block.mode);
if (strlen(Block.uid) != 0)
{
FREE(Block.uid);
}
return 0;
}
/* check rhs 2 (flag) */
il2 = (int *) GetData(2);
m2 = il2[1];
n2 = il2[2];
if ((il2[0] != 1) || (m2 * n2 != 1))
{
Scierror(888, _("%s : Second argument must be scalar.\n"), fname);
return 0;
}
flag = (scicos_flag) * ((double *)(&il2[4]));
/* check rhs 3 (time) */
il3 = (int *) GetData(3);
m3 = il3[1];
n3 = il3[2];
if ((il3[0] != 1) || (m3 * n3 != 1))
{
Scierror(888, _("%s : Third argument must be scalar.\n"), fname);
return 0;
}
t = *((double *)(&il3[4]));
/* call block */
callf(&t, &Block, &flag);
/* build output scilab structure */
TopSave = Top;
ierr = createblklist(&Block, &ierr, -1, Block.type);
FREE(Block.z);
FREE(Block.ozsz);
FREE(Block.oztyp);
for (j = 0; j < Block.noz; j++)
{
FREE(Block.ozptr[j]);
}
FREE(Block.ozptr);
FREE(Block.x);
FREE(Block.xd);
FREE(Block.res);
FREE(Block.insz);
for (j = 0; j < Block.nin; j++)
{
FREE(Block.inptr[j]);
}
FREE(Block.inptr);
FREE(Block.outsz);
for (j = 0; j < Block.nout; j++)
{
FREE(Block.outptr[j]);
}
FREE(Block.outptr);
FREE(Block.evout);
FREE(Block.rpar);
FREE(Block.ipar);
FREE(Block.oparsz);
FREE(Block.opartyp);
for (j = 0; j < Block.nopar; j++)
{
FREE(Block.oparptr[j]);
}
FREE(Block.oparptr);
FREE(Block.g);
FREE(Block.jroot);
if (strlen(Block.label) != 0)
{
FREE(Block.label);
}
FREE(Block.mode);
if (Block.uid != NULL && strlen(Block.uid) != 0)
{
FREE(Block.uid);
}
Top = TopSave;
CreateVar(4, TYPED_LIST_DATATYPE, &nblklst, (j = 1, &j), &l_tmp);
LhsVar(1) = 4;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_gsort(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
types::Double* pDblInd = NULL;
std::wstring wstrWay = L"d";
std::wstring wstrProcess = L"g";
if (in.size() < 1 || in.size() > 3)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "gsort", 1, 3);
return types::Function::Error;
}
if (_iRetCount > 2)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d to %d expected.\n"), "gsort", 1, 2);
return types::Function::Error;
}
/***** get data and perform operation *****/
if (in.size() == 3) // get Direction
{
if (in[2]->isString() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : A string expected.\n"), "gsort", 3);
return types::Function::Error;
}
wstrWay = in[2]->getAs<types::String>()->get(0);
if (wstrWay != L"i" && wstrWay != L"d")
{
Scierror(999, _("%s: Wrong value for input argument #%d: ['i' 'd'] expected.\n"), "gsort", 3);
return types::Function::Error;
}
}
if (in.size() >= 2) // get Option
{
if (in[1]->isString() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : A string expected.\n"), "gsort", 2);
return types::Function::Error;
}
wstrProcess = in[1]->getAs<types::String>()->get(0);
if ( wstrProcess != L"c" &&
wstrProcess != L"r" &&
wstrProcess != L"g" &&
wstrProcess != L"lc" &&
wstrProcess != L"lr")
{
Scierror(999, _("%s: Wrong value for input argument #%d: ['g' 'r' 'c' 'lc' 'lr'] expected.\n"), "gsort", 2);
return types::Function::Error;
}
}
// get data and perform operation for each types::
if (in[0]->isGenericType() == false)
{
ast::ExecVisitor exec;
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_gsort";
return Overload::call(wstFuncName, in, _iRetCount, out, &exec);
}
types::GenericType* pGTOut = in[0]->getAs<types::GenericType>();
if (pGTOut->getDims() > 2)
{
ast::ExecVisitor exec;
return Overload::call(L"%hm_gsort", in, _iRetCount, out, &exec);
}
if (_iRetCount == 2)
{
int iRowsInd = (wstrProcess == L"lc") ? 1 : pGTOut->getRows();
int iColsInd = (wstrProcess == L"lr") ? 1 : pGTOut->getCols();
pDblInd = new types::Double(iRowsInd, iColsInd);
}
if (in[0]->isDouble()) // double
{
types::Double* pDblIn = in[0]->getAs<types::Double>();
// doc says : "With complex numbers, gsort can be overloaded"
if (pDblIn->isComplex() && symbol::Context::getInstance()->getFunction(symbol::Symbol(L"%_gsort")))
{
if (_iRetCount == 2)
{
delete pDblInd;
}
ast::ExecVisitor exec;
return Overload::call(L"%_gsort", in, _iRetCount, out, &exec);
}
types::Double* pDblOut = gsort(pDblIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pDblOut);
}
else if (in[0]->isSparse()) // sparse
{
if (_iRetCount == 2)
{
delete pDblInd;
}
ast::ExecVisitor exec;
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_gsort";
return Overload::call(wstFuncName, in, _iRetCount, out, &exec);
}
else if (in[0]->isString()) // string
{
types::String* pStringIn = in[0]->getAs<types::String>();
types::String* pStringOut = gsort(pStringIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pStringOut);
}
else if (in[0]->isInt8()) // int
{
types::Int8* pIIn = in[0]->getAs<types::Int8>();
types::Int8* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isInt16())
{
types::Int16* pIIn = in[0]->getAs<types::Int16>();
types::Int16* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isInt32())
{
types::Int32* pIIn = in[0]->getAs<types::Int32>();
types::Int32* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isInt64())
{
types::Int64* pIIn = in[0]->getAs<types::Int64>();
types::Int64* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isUInt8()) // uint
{
types::UInt8* pIIn = in[0]->getAs<types::UInt8>();
types::UInt8* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isUInt16())
{
types::UInt16* pIIn = in[0]->getAs<types::UInt16>();
types::UInt16* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isUInt32())
{
types::UInt32* pIIn = in[0]->getAs<types::UInt32>();
types::UInt32* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isUInt64())
{
types::UInt64* pIIn = in[0]->getAs<types::UInt64>();
types::UInt64* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else
{
ast::ExecVisitor exec;
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_gsort";
return Overload::call(wstFuncName, in, _iRetCount, out, &exec);
}
/***** set result *****/
if (_iRetCount == 2)
{
out.push_back(pDblInd);
}
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
int gw_umfpack(void)
{
Scierror(999, _("Scilab UMFPACK module not installed.\n"));
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_TCL_GetVersion(char *fname, unsigned long l)
{
static int l1, n1, m1;
int major = 0;
int minor = 0;
int patchLevel = 0;
int type = 0;
char *output = NULL ;
char VersionString[256];
char ReleaseType[256];
CheckRhs(0, 1);
CheckLhs(1, 1);
Tcl_GetVersion(&major, &minor, &patchLevel, &type);
if (Rhs == 0)
{
switch (type)
{
case TCL_ALPHA_RELEASE:
strcpy(ReleaseType, _("Alpha Release"));
break;
case TCL_BETA_RELEASE:
strcpy(ReleaseType, _("Beta Release"));
break;
case TCL_FINAL_RELEASE:
strcpy(ReleaseType, _("Final Release"));
break;
default:
strcpy(ReleaseType, _("Unknown Release"));
break;
}
sprintf(VersionString, "TCL/TK %d.%d.%d %s", major, minor, patchLevel, ReleaseType);
output = strdup(VersionString);
n1 = 1;
m1 = (int)strlen(output);
CreateVarFromPtr(Rhs + 1, STRING_DATATYPE, &m1, &n1, &output);
if (output)
{
FREE(output);
output = NULL;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
if (GetType(1) == sci_strings)
{
char *Param = NULL;
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
Param = cstk(l1);
if (strcmp(Param, "numbers") == 0)
{
int *VERSIONMATRIX = NULL;
VERSIONMATRIX = (int *)MALLOC( (4) * sizeof(int) );
VERSIONMATRIX[0] = (int)major;
VERSIONMATRIX[1] = (int)minor;
VERSIONMATRIX[2] = (int)patchLevel;
VERSIONMATRIX[3] = (int)type;
m1 = 1;
n1 = 4;
CreateVarFromPtr(Rhs + 1, MATRIX_OF_INTEGER_DATATYPE, &m1, &n1 , &VERSIONMATRIX);
if (VERSIONMATRIX)
{
FREE(VERSIONMATRIX);
VERSIONMATRIX = NULL;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' expected.\n"), fname, 1, "numbers");
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1);
}
}
return 0;
}
/*------------------------------------------------------------------------*/
int set_xtics_coord_property(void* _pvCtx, char* pobjUID, size_t stackPointer, int valueType, int nbRow, int nbCol )
{
BOOL status = FALSE;
int N = 0;
double * vector = NULL;
char c_format[5];
int iXNumberTicks = 0;
int* piXNumberTicks = &iXNumberTicks;
char** stringVector = NULL;
double* coordsVector = NULL;
int iTicksStyle = 0;
int* piTicksStyle = &iTicksStyle;
char ticksStyle = 0;
if ( !( valueType == sci_matrix ) )
{
Scierror(999, _("Wrong type for '%s' property: Real matrix expected.\n"), "xtics_coord");
return SET_PROPERTY_ERROR;
}
if ( nbRow != 1 )
{
Scierror(999, _("Wrong size for '%s' property: Row vector expected.\n"), "xtics_coord");
return SET_PROPERTY_ERROR;
}
getGraphicObjectProperty(pobjUID, __GO_X_NUMBER_TICKS__, jni_int, (void**)&piXNumberTicks);
if (piXNumberTicks == NULL)
{
Scierror(999, _("'%s' property does not exist for this handle.\n"), "xtics_coord");
return SET_PROPERTY_ERROR;
}
if ( iXNumberTicks == 1 && nbCol != 1 )
{
Scierror(999, _("Wrong size for '%s' property: Scalar expected.\n"), "xtics_coord");
return SET_PROPERTY_ERROR;
}
if ( iXNumberTicks != 1 && nbCol == 1 )
{
Scierror(999, _("Wrong size for '%s' property: At least %d elements expected.\n"), "xtics_coord", 2);
return SET_PROPERTY_ERROR;
}
/* what follows remains here as it was */
coordsVector = createCopyDoubleVectorFromStack( stackPointer, nbCol );
status = setGraphicObjectProperty(pobjUID, __GO_X_TICKS_COORDS__, coordsVector, jni_double_vector, nbCol);
if (status == FALSE)
{
FREE(coordsVector);
Scierror(999, _("'%s' property does not exist for this handle.\n"), "xtics_coord");
return SET_PROPERTY_ERROR;
}
FREE(coordsVector);
getGraphicObjectProperty(pobjUID, __GO_TICKS_STYLE__, jni_int, (void**)&piTicksStyle);
if (iTicksStyle == 0)
{
ticksStyle = 'v';
}
else if (iTicksStyle == 1)
{
ticksStyle = 'r';
}
else if (iTicksStyle == 2)
{
ticksStyle = 'i';
}
if (ComputeXIntervals( pobjUID, ticksStyle, &vector, &N, 0 ) != 0)
{
/* Something wrong happened */
FREE( vector );
return -1;
}
if (ComputeC_format( pobjUID, c_format ) != 0)
{
/* Something wrong happened */
FREE( vector );
return -1;
}
stringVector = copyFormatedArray( vector, N, c_format, 256 );
status = setGraphicObjectProperty(pobjUID, __GO_TICKS_LABELS__, stringVector, jni_string_vector, N);
FREE( vector );
destroyStringArray(stringVector, N);
if (status == TRUE)
{
return SET_PROPERTY_SUCCEED;
}
else
{
return SET_PROPERTY_ERROR;
}
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_cumprod(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
types::Double* pDblIn = NULL;
types::Double* pDblOut = NULL;
types::Polynom* pPolyIn = NULL;
types::Polynom* pPolyOut = NULL;
int iOrientation = 0;
int iOuttype = 1; // 1 = native | 2 = double (type of output value)
if (in.size() < 1 || in.size() > 3)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "cumprod", 1, 3);
return types::Function::Error;
}
if (_iRetCount > 1)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "cumprod", 1);
return types::Function::Error;
}
bool isCloned = true;
/***** get data *****/
switch (in[0]->getType())
{
case InternalType::ScilabDouble :
pDblIn = in[0]->getAs<types::Double>();
isCloned = false;
break;
case InternalType::ScilabBool:
pDblIn = getAsDouble(in[0]->getAs<types::Bool>());
iOuttype = 2;
break;
case InternalType::ScilabPolynom :
pPolyIn = in[0]->getAs<types::Polynom>();
isCloned = false;
break;
case InternalType::ScilabInt8:
pDblIn = getAsDouble(in[0]->getAs<types::Int8>());
break;
case InternalType::ScilabInt16:
pDblIn = getAsDouble(in[0]->getAs<types::Int16>());
break;
case InternalType::ScilabInt32:
pDblIn = getAsDouble(in[0]->getAs<types::Int32>());
break;
case InternalType::ScilabInt64:
pDblIn = getAsDouble(in[0]->getAs<types::Int64>());
break;
case InternalType::ScilabUInt8:
pDblIn = getAsDouble(in[0]->getAs<types::UInt8>());
break;
case InternalType::ScilabUInt16:
pDblIn = getAsDouble(in[0]->getAs<types::UInt16>());
break;
case InternalType::ScilabUInt32:
pDblIn = getAsDouble(in[0]->getAs<types::UInt32>());
break;
case InternalType::ScilabUInt64:
pDblIn = getAsDouble(in[0]->getAs<types::UInt64>());
break;
default :
ast::ExecVisitor exec;
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_cumprod";
return Overload::call(wstFuncName, in, _iRetCount, out, &exec);
}
if (in.size() >= 2)
{
if (in[1]->isDouble())
{
types::Double* pDbl = in[1]->getAs<types::Double>();
if (pDbl->isScalar() == false)
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong value for input argument #%d: A positive scalar expected.\n"), "cumprod", 2);
return types::Function::Error;
}
iOrientation = static_cast<int>(pDbl->get(0));
if (iOrientation <= 0)
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong value for input argument #%d: A positive scalar expected.\n"), "cumprod", 2);
return types::Function::Error;
}
}
else if (in[1]->isString())
{
types::String* pStr = in[1]->getAs<types::String>();
if (pStr->isScalar() == false)
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar string expected.\n"), "cumprod", 2);
return types::Function::Error;
}
wchar_t* wcsString = pStr->get(0);
if (wcscmp(wcsString, L"*") == 0)
{
iOrientation = 0;
}
else if (wcscmp(wcsString, L"r") == 0)
{
iOrientation = 1;
}
else if (wcscmp(wcsString, L"c") == 0)
{
iOrientation = 2;
}
else if (wcscmp(wcsString, L"m") == 0)
{
int iDims = 0;
int* piDimsArray = NULL;
if (pDblIn)
{
iDims = pDblIn->getDims();
piDimsArray = pDblIn->getDimsArray();
}
else
{
iDims = pPolyIn->getDims();
piDimsArray = pPolyIn->getDimsArray();
}
// old function was "mtlsel"
for (int i = 0; i < iDims; i++)
{
if (piDimsArray[i] > 1)
{
iOrientation = i + 1;
break;
}
}
}
else if ((wcscmp(wcsString, L"native") == 0) && (in.size() == 2))
{
iOuttype = 1;
}
else if ((wcscmp(wcsString, L"double") == 0) && (in.size() == 2))
{
iOuttype = 2;
}
else
{
const char* pstrExpected = NULL;
if (in.size() == 2)
{
pstrExpected = "\"*\",\"r\",\"c\",\"m\",\"native\",\"double\"";
}
else
{
pstrExpected = "\"*\",\"r\",\"c\",\"m\"";
}
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong value for input argument #%d: Must be in the set {%s}.\n"), "cumprod", 2, pstrExpected);
return types::Function::Error;
}
}
else
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix or a string expected.\n"), "cumprod", 2);
return types::Function::Error;
}
}
if (in.size() == 3)
{
if (in[2]->isString() == false)
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), "cumprod", 3);
return types::Function::Error;
}
types::String* pStr = in[2]->getAs<types::String>();
if (pStr->isScalar() == false)
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar string expected.\n"), "cumprod", 3);
return types::Function::Error;
}
wchar_t* wcsString = pStr->get(0);
if (wcscmp(wcsString, L"native") == 0)
{
iOuttype = 1;
}
else if (wcscmp(wcsString, L"double") == 0)
{
iOuttype = 2;
}
else
{
if (isCloned)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong value for input argument #%d: %s or %s expected.\n"), "cumprod", 3, "\"native\"", "\"double\"");
return types::Function::Error;
}
}
/***** perform operation *****/
if (pDblIn)
{
if (iOrientation > pDblIn->getDims())
{
if (in[0]->isDouble())
{
pDblOut = pDblIn->clone()->getAs<types::Double>();
}
else
{
pDblOut = pDblIn;
}
if (in[0]->isBool() == false)
{
iOuttype = 2;
}
}
else
{
pDblOut = new types::Double(pDblIn->getDims(), pDblIn->getDimsArray(), pDblIn->isComplex());
cumprod(pDblIn, iOrientation, pDblOut);
if (isCloned)
{
delete pDblIn;
pDblIn = NULL;
}
}
}
else if (pPolyIn)
{
iOuttype = 1;
if (iOrientation > pPolyIn->getDims())
{
pPolyOut = pPolyIn->clone()->getAs<types::Polynom>();
}
else
{
pPolyOut = new types::Polynom(pPolyIn->getVariableName(), pPolyIn->getDims(), pPolyIn->getDimsArray());
pPolyOut->setComplex(pPolyIn->isComplex());
cumprod(pPolyIn, iOrientation, pPolyOut);
}
}
/***** set result *****/
if ((iOuttype == 1) && (in[0]->isDouble() == false))
{
switch (in[0]->getType())
{
case InternalType::ScilabBool:
{
types::Bool* pB = new types::Bool(pDblOut->getDims(), pDblOut->getDimsArray());
int* p = pB->get();
double* pd = pDblOut->get();
int size = pB->getSize();
for (int i = 0; i < size; ++i)
{
p[i] = pd[i] != 0 ? 1 : 0;
}
out.push_back(pB);
break;
}
case InternalType::ScilabPolynom:
{
out.push_back(pPolyOut);
break;
}
case InternalType::ScilabInt8:
{
out.push_back(toInt<types::Int8>(pDblOut));
break;
}
case InternalType::ScilabInt16:
{
out.push_back(toInt<types::Int16>(pDblOut));
break;
}
case InternalType::ScilabInt32:
{
out.push_back(toInt<types::Int32>(pDblOut));
break;
}
case InternalType::ScilabInt64:
{
out.push_back(toInt<types::Int64>(pDblOut));
break;
}
case InternalType::ScilabUInt8:
{
out.push_back(toInt<types::UInt8>(pDblOut));
break;
}
case InternalType::ScilabUInt16:
{
out.push_back(toInt<types::UInt16>(pDblOut));
break;
}
case InternalType::ScilabUInt32:
{
out.push_back(toInt<types::UInt32>(pDblOut));
break;
}
case InternalType::ScilabUInt64:
{
out.push_back(toInt<types::UInt64>(pDblOut));
break;
}
}
if (pDblOut)
{
delete pDblOut;
}
}
else
{
out.push_back(pDblOut);
}
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_gsort(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
// In all cases, to later test in[0]:
if (in.size() < 1)
{
Scierror(77, _("%s: Wrong number of input argument(s): At least %d expected.\n"), "gsort", 1);
return types::Function::Error;
}
// The maximal number of input args may depend on the input data type, due to specific options
//
// Special cases
//
if (in[0]->isGenericType() == false)
{
// custom types
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_gsort";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
types::GenericType* pGTIn = in[0]->getAs<types::GenericType>();
if (pGTIn->getDims() > 2)
{
// hypermatrix
return Overload::call(L"%hm_gsort", in, _iRetCount, out);
}
if (pGTIn->isSparse())
{
// sparse
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_gsort";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
if (pGTIn->isComplex() && symbol::Context::getInstance()->getFunction(symbol::Symbol(L"%_gsort")))
{
// complex is documented as being managed through overloading
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_gsort";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
//
// Common case
//
if (in.size() > 3)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "gsort", 1, 3);
return types::Function::Error;
}
if (_iRetCount > 2)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d to %d expected.\n"), "gsort", 1, 2);
return types::Function::Error;
}
// Get the sorting order
std::wstring wstrWay = L"d";
if (in.size() > 2)
{
if (in[2]->isString() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : string expected.\n"), "gsort", 3);
return types::Function::Error;
}
wstrWay = in[2]->getAs<types::String>()->get(0);
if (wstrWay != L"i" && wstrWay != L"d")
{
Scierror(999, _("%s: Wrong value for input argument #%d: %s expected.\n"), "gsort", 3, "'i'|'d'");
return types::Function::Error;
}
}
// Get the sorting method
std::wstring wstrProcess = L"g";
if (in.size() >= 2)
{
if (in[1]->isString() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : string expected.\n"), "gsort", 2);
return types::Function::Error;
}
wstrProcess = in[1]->getAs<types::String>()->get(0);
if ( wstrProcess != L"c" &&
wstrProcess != L"r" &&
wstrProcess != L"g" &&
wstrProcess != L"lc" &&
wstrProcess != L"lr")
{
Scierror(999, _("%s: Wrong value for input argument #%d: ['g' 'r' 'c' 'lc' 'lr'] expected.\n"), "gsort", 2);
return types::Function::Error;
}
}
// Get data and perform operation for each types::
types::Double* pDblInd = NULL;
if (_iRetCount == 2)
{
int iRowsInd = (wstrProcess == L"lc") ? 1 : pGTIn->getRows();
int iColsInd = (wstrProcess == L"lr") ? 1 : pGTIn->getCols();
pDblInd = new types::Double(iRowsInd, iColsInd);
}
if (in[0]->isDouble()) // double
{
types::Double* pDblIn = in[0]->getAs<types::Double>();
types::Double* pDblOut = gsort(pDblIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pDblOut);
}
else if (in[0]->isString()) // string
{
types::String* pStringIn = in[0]->getAs<types::String>();
types::String* pStringOut = gsort(pStringIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pStringOut);
}
else if (in[0]->isInt8()) // int
{
types::Int8* pIIn = in[0]->getAs<types::Int8>();
types::Int8* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isInt16())
{
types::Int16* pIIn = in[0]->getAs<types::Int16>();
types::Int16* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isInt32())
{
types::Int32* pIIn = in[0]->getAs<types::Int32>();
types::Int32* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isInt64())
{
types::Int64* pIIn = in[0]->getAs<types::Int64>();
types::Int64* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isUInt8()) // uint
{
types::UInt8* pIIn = in[0]->getAs<types::UInt8>();
types::UInt8* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isUInt16())
{
types::UInt16* pIIn = in[0]->getAs<types::UInt16>();
types::UInt16* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isUInt32())
{
types::UInt32* pIIn = in[0]->getAs<types::UInt32>();
types::UInt32* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else if (in[0]->isUInt64())
{
types::UInt64* pIIn = in[0]->getAs<types::UInt64>();
types::UInt64* pIOut = gsort(pIIn, pDblInd, wstrWay, wstrProcess);
out.push_back(pIOut);
}
else // Other generic data types not supported
{
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_gsort";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
// Returns indices when requested
if (_iRetCount == 2)
{
out.push_back(pDblInd);
}
return types::Function::OK;
}
types::Function::ReturnValue sci_fieldnames(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() != 1)
{
Scierror(999, _("%s: Wrong number of input argument(s): %d expected.\n"), "fieldnames", 1);
return types::Function::Error;
}
// FIXME : iso-functionnal to Scilab < 6
// Works on other types except userType, {m,t}list and struct
if (in[0]->isStruct() == false && in[0]->isMList() == false && in[0]->isTList() == false && in[0]->isUserType() == false)
{
out.push_back(types::Double::Empty());
return types::Function::OK;
}
// STRUCT
if (in[0]->isStruct() == true)
{
types::String* pFields = in[0]->getAs<types::Struct>()->getFieldNames();
if (pFields)
{
if (pFields->getSize() == 0)
{
delete pFields;
out.push_back(types::Double::Empty());
}
else
{
out.push_back(pFields);
//delete pFields;
}
}
else
{
out.push_back(types::Double::Empty());
}
return types::Function::OK;
}
types::InternalType* pIT = nullptr;
// TLIST or MLIST
if (in[0]->isList() == true)
{
// We only need list capabilities to retrieve first argument as List.
types::List *pInList = in[0]->getAs<types::List>();
pIT = pInList->get(0);
if (pIT == nullptr || pIT->isString() == false)
{
// FIXME : iso-functionnal to Scilab < 6
// Works on other types except userType, {m,t}list and struct
out.push_back(types::Double::Empty());
return types::Function::OK;
}
}
// USER-TYPE (typically an Xcos object)
if (in[0]->isUserType() == true)
{
// We only need userType capabilities to retrieve first argument as UserType.
types::UserType *pInUser = in[0]->getAs<types::UserType>();
// Extract the sub-type
std::wstring subType (pInUser->getShortTypeStr());
// Extract the properties
types::typed_list one(1, new types::Double(1));
types::InternalType* pProperties = pInUser->extract(&one);
if (pProperties == nullptr || pProperties->isString() == false)
{
// FIXME : iso-functionnal to Scilab < 6
// Works on other types except userType, {m,t}list and struct
out.push_back(types::Double::Empty());
return types::Function::OK;
}
int nProp = ((types::String*) pProperties)->getSize();
pIT = new types::String(nProp + 1, 1);
((types::String*) pIT)->set(0, subType.data());
for (int i = 0; i < nProp; ++i)
{
((types::String*) pIT)->set(i + 1, ((types::String*)pProperties)->get(i));
}
}
types::String *pAllFields;
if (pIT)
{
pAllFields = pIT->getAs<types::String>();
}
else
{
Scierror(999, _("Could not retrieve sub-type.\n"));
return types::Function::Error;
}
wchar_t **pwcsAllStrings = pAllFields->get();
// shift to forget first value corresponding to type.
// ++pwcsAllStrings;
types::String *pNewString = new types::String(pAllFields->getSize() - 1, 1, pwcsAllStrings + 1);
out.push_back(pNewString);
return types::Function::OK;
}
types::Function::ReturnValue sci_eval_cshep2d(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
// input
types::Double* pDblXp = NULL;
types::Double* pDblYp = NULL;
types::TList* pTListCoef = NULL;
types::Double* pDblCoef = NULL;
types::Int32* pInt32Cell = NULL;
types::Int32* pInt32Next = NULL;
types::Double* pDblGrid = NULL;
types::Double* pDblRMax = NULL;
types::Double* pDblRW = NULL;
types::Double* pDblA = NULL;
// output
types::Double* pDblF = NULL;
types::Double* pDblDfdx = NULL;
types::Double* pDblDfdy = NULL;
types::Double* pDblDffdxx = NULL;
types::Double* pDblDffdxy = NULL;
types::Double* pDblDffdyy = NULL;
// *** check the minimal number of input args. ***
if (in.size() != 3)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "eval_cshep2d", 3);
return types::Function::Error;
}
// *** check number of output args according the methode. ***
if (_iRetCount != 3 && _iRetCount != 6 && _iRetCount > 1)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d, %d or %d expected.\n"), "eval_cshep2d", 1, 3, 6);
return types::Function::Error;
}
// *** check type of input args and get it. ***
//xp
if (in[0]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : A matrix expected.\n"), "eval_cshep2d", 1);
return types::Function::Error;
}
pDblXp = in[0]->getAs<types::Double>();
if (pDblXp->isComplex())
{
Scierror(999, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), "eval_cshep2d", 1);
return types::Function::Error;
}
//yp
if (in[1]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : A matrix expected.\n"), "eval_cshep2d", 2);
return types::Function::Error;
}
pDblYp = in[1]->getAs<types::Double>();
if (pDblYp->getRows() != pDblXp->getRows() || pDblYp->getCols() != pDblXp->getCols())
{
Scierror(999, _("%s: Wrong size for input arguments #%d and #%d: Same size expected.\n"), "eval_cshep2d", 1, 2);
return types::Function::Error;
}
if (pDblYp->isComplex())
{
Scierror(999, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), "eval_cshep2d", 2);
return types::Function::Error;
}
//coef
if (in[2]->isTList() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : A tlist of type %s expected.\n"), "eval_cshep2d", 3, "cshep2d");
return types::Function::Error;
}
pTListCoef = in[2]->getAs<types::TList>();
if (pTListCoef->getTypeStr() != L"cshep2d")
{
Scierror(999, _("%s: Wrong type for input argument #%d: A %s tlist expected.\n"), "eval_cshep2d", 3, "cshep2d");
return types::Function::Error;
}
pDblCoef = pTListCoef->getField(L"xyz")->getAs<types::Double>();
pInt32Cell = pTListCoef->getField(L"lcell")->getAs<types::Int32>();
pInt32Next = pTListCoef->getField(L"lnext")->getAs<types::Int32>();
pDblGrid = pTListCoef->getField(L"grdim")->getAs<types::Double>();
pDblRMax = pTListCoef->getField(L"rmax")->getAs<types::Double>();
pDblRW = pTListCoef->getField(L"rw")->getAs<types::Double>();
pDblA = pTListCoef->getField(L"a")->getAs<types::Double>();
// *** Perform operation. ***
int ier = 0;
int nr = pInt32Cell->getRows();
int rows = pDblCoef->getRows();
int sizeOfXp = pDblXp->getSize();
pDblF = new types::Double(pDblXp->getRows(), pDblXp->getCols());
if (_iRetCount == 1)
{
for (int i = 0; i < sizeOfXp; i++)
{
double ret = C2F(cs2val)(pDblXp->get() + i, pDblYp->get() + i, &rows, pDblCoef->get(),
pDblCoef->get() + rows, pDblCoef->get() + (2 * rows), &nr,
pInt32Cell->get(), pInt32Next->get(), pDblGrid->get(),
pDblGrid->get() + 1, pDblGrid->get() + 2, pDblGrid->get() + 3,
pDblRMax->get(), pDblRW->get(), pDblA->get());
pDblF->set(i, ret);
}
}
else// if(_iRetCount > 2)
{
pDblDfdx = new types::Double(pDblXp->getRows(), pDblXp->getCols());
pDblDfdy = new types::Double(pDblXp->getRows(), pDblXp->getCols());
if (_iRetCount == 3)
{
for (int i = 0; i < sizeOfXp; i++)
{
C2F(cs2grd)(pDblXp->get() + i, pDblYp->get() + i, &rows, pDblCoef->get(),
pDblCoef->get() + rows, pDblCoef->get() + (2 * rows), &nr,
pInt32Cell->get(), pInt32Next->get(), pDblGrid->get(),
pDblGrid->get() + 1, pDblGrid->get() + 2, pDblGrid->get() + 3,
pDblRMax->get(), pDblRW->get(), pDblA->get(), pDblF->get() + i,
pDblDfdx->get() + i, pDblDfdy->get() + i, &ier);
}
}
else // == 6
{
pDblDffdxx = new types::Double(pDblXp->getRows(), pDblXp->getCols());
pDblDffdxy = new types::Double(pDblXp->getRows(), pDblXp->getCols());
pDblDffdyy = new types::Double(pDblXp->getRows(), pDblXp->getCols());
for (int i = 0; i < sizeOfXp; i++)
{
C2F(cs2hes)(pDblXp->get() + i, pDblYp->get() + i, &rows, pDblCoef->get(),
pDblCoef->get() + rows, pDblCoef->get() + (2 * rows), &nr,
pInt32Cell->get(), pInt32Next->get(), pDblGrid->get(),
pDblGrid->get() + 1, pDblGrid->get() + 2, pDblGrid->get() + 3,
pDblRMax->get(), pDblRW->get(), pDblA->get(), pDblF->get() + i,
pDblDfdx->get() + i, pDblDfdy->get() + i, pDblDffdxx->get() + i,
pDblDffdxy->get() + i, pDblDffdyy->get() + i, &ier);
}
}
}
// *** Return result in Scilab. ***
out.push_back(pDblF);
if (_iRetCount > 2)
{
out.push_back(pDblDfdx);
out.push_back(pDblDfdy);
}
if (_iRetCount == 6)
{
out.push_back(pDblDffdxx);
out.push_back(pDblDffdyy);
out.push_back(pDblDffdxy);
}
return types::Function::OK;
}
// dummy function definition for non nwni compatible modules
static void dummy()
{
char* fname = wide_string_to_UTF8(ConfigVariable::getWhere().back().m_name.c_str());
Scierror(999, _("Scilab '%s' function disabled in -nogui or -nwni mode.\n"), fname);
FREE(fname);
}
/*--------------------------------------------------------------------------*/
int get_style_arg(char *fname,int pos, int n1,rhs_opts opts[], int ** style )
{
int m = 0,n = 0,l = 0, first_opt = FirstOpt(), kopt = 0, un = 1, ix = 0, i = 0, l1 = 0;
Nbvars = Max(Nbvars,Rhs);
if ( pos < first_opt ) /* regular argument */
{
if (VarType(pos))
{
GetRhsVar(pos,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
if (m * n < n1)
{
Scierror(999,_("%s: Wrong size for input argument #%d: %d < %d expected.\n"),fname,pos, m*n,n1);
return 0;
}
if ( n1 == 1 && m * n == 1 )
{
ix = 2;
CreateVar(Nbvars+1,MATRIX_OF_INTEGER_DATATYPE,&un,&ix,&l1);
*istk(l1)=*istk(l);
*istk(l1+1)=1;
l=l1;
}
*style = istk(l);
}
else /* zero type argument --> default value */
{
ix = Max(n1,2);
CreateVar(Nbvars+1,MATRIX_OF_INTEGER_DATATYPE,&un,&ix,&l);
for ( i = 0 ; i < n1 ; ++i )
{
*istk(l + i) = i+1 ;
}
if (n1 == 1)
{
*istk(l + 1) = 1 ;
}
*style = istk(l);
}
}
else if ((kopt=FindOpt("style",opts)))
{ /* named argument: style=value */
GetRhsVar(kopt,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
if (m * n < n1)
{
Scierror(999,_("%s: Wrong size for input argument #%d: %d < %d expected.\n"),fname,kopt,m*n,n1);
return 0;
}
if (n1==1&&m*n==1)
{
ix = 2;
CreateVar(Nbvars+1,MATRIX_OF_INTEGER_DATATYPE,&un,&ix,&l1);
*istk(l1)=*istk(l);
*istk(l1+1)=1;
l=l1;
}
*style = istk(l);
}
else /* unspecified argument --> default value */
{
ix = Max(n1,2);
CreateVar(Nbvars+1,MATRIX_OF_INTEGER_DATATYPE,&un,&ix,&l);
for (i = 0 ; i < n1 ; ++i)
{
*istk(l + i) = i+1;
}
if (n1 == 1)
{
*istk(l +1) = 1;
}
*style = istk(l);
}
return 1;
}
Callable::ReturnValue DynamicFunction::Init()
{
/*Load library*/
if (m_wstLibName.empty())
{
Scierror(999, _("%s: Library name must not be empty\n."), m_wstName.c_str());
return Error;
}
DynLibHandle hLib = getDynModule(m_wstLibName.c_str());
if (hLib == 0)
{
char* pstLibName = wide_string_to_UTF8(m_wstLibName.c_str());
hLib = LoadDynLibrary(pstLibName);
if (hLib == 0)
{
//2nd chance for linux !
#ifndef _MSC_VER
char* pstError = strdup(GetLastDynLibError());
/* Haven't been able to find the lib with dlopen...
* This can happen for two reasons:
* - the lib must be dynamically linked
* - Some silly issues under Suse (see bug #2875)
* Note that we are handling only the "source tree build"
* because libraries are split (they are in the same directory
* in the binary)
*/
wchar_t* pwstScilabPath = getSCIW();
wchar_t pwstModulesPath[] = L"/modules/";
wchar_t pwstLTDir[] = L".libs/";
/* Build the full path to the library */
int iPathToLibLen = (wcslen(pwstScilabPath) + wcslen(pwstModulesPath) + wcslen(m_wstModule.c_str()) + wcslen(L"/") + wcslen(pwstLTDir) + wcslen(m_wstLibName.c_str()) + 1);
wchar_t* pwstPathToLib = (wchar_t*)MALLOC(iPathToLibLen * sizeof(wchar_t));
os_swprintf(pwstPathToLib, iPathToLibLen, L"%ls%ls%ls/%ls%ls", pwstScilabPath, pwstModulesPath, m_wstModule.c_str(), pwstLTDir, m_wstLibName.c_str());
FREE(pwstScilabPath);
char* pstPathToLib = wide_string_to_UTF8(pwstPathToLib);
FREE(pwstPathToLib);
hLib = LoadDynLibrary(pstPathToLib);
if (hLib == 0)
{
Scierror(999, _("An error has been detected while loading %s: %s\n"), pstLibName, pstError);
FREE(pstError);
pstError = GetLastDynLibError();
Scierror(999, _("An error has been detected while loading %s: %s\n"), pstPathToLib, pstError);
FREE(pstLibName);
FREE(pstPathToLib);
return Error;
}
FREE(pstPathToLib);
FREE(pstError);
#else
char* pstError = wide_string_to_UTF8(m_wstLibName.c_str());
Scierror(999, _("Impossible to load %s library\n"), pstError);
FREE(pstError);
FREE(pstLibName);
return Error;
#endif
}
FREE(pstLibName);
addDynModule(m_wstLibName.c_str(), hLib);
/*Load deps*/
if (m_wstLoadDepsName.empty() == false && m_pLoadDeps == NULL)
{
char* pstLoadDepsName = wide_string_to_UTF8(m_wstLoadDepsName.c_str());
m_pLoadDeps = (LOAD_DEPS)GetDynLibFuncPtr(hLib, pstLoadDepsName);
FREE(pstLoadDepsName);
}
}
/*Load gateway*/
if (m_wstName != L"")
{
char* pstEntryPoint = wide_string_to_UTF8(m_wstEntryPoint.c_str());
switch (m_iType)
{
case EntryPointCPPOpt :
m_pOptFunc = (GW_FUNC_OPT)GetDynLibFuncPtr(hLib, pstEntryPoint);
break;
case EntryPointCPP :
m_pFunc = (GW_FUNC)GetDynLibFuncPtr(hLib, pstEntryPoint);
break;
case EntryPointOldC :
m_pOldFunc = (OLDGW_FUNC)GetDynLibFuncPtr(hLib, pstEntryPoint);
break;
case EntryPointMex:
m_pMexFunc = (MEXGW_FUNC)GetDynLibFuncPtr(hLib, pstEntryPoint);
break;
case EntryPointC:
m_pCFunc = (GW_C_FUNC)GetDynLibFuncPtr(hLib, pstEntryPoint);
break;
}
FREE(pstEntryPoint);
}
if (m_pFunc == NULL && m_pOldFunc == NULL && m_pMexFunc == NULL && m_pOptFunc == NULL && m_pCFunc == NULL)
{
char* pstEntry = wide_string_to_UTF8(m_wstEntryPoint.c_str());
char* pstLib = wide_string_to_UTF8(m_wstLibName.c_str());
Scierror(999, _("Impossible to load %s function in %s library: %s\n"), pstEntry, pstLib, GetLastDynLibError());
FREE(pstEntry);
FREE(pstLib);
return Error;
}
switch (m_iType)
{
case EntryPointCPPOpt :
m_pFunction = new OptFunction(m_wstName, m_pOptFunc, m_pLoadDeps, m_wstModule);
break;
case EntryPointCPP :
m_pFunction = new Function(m_wstName, m_pFunc, m_pLoadDeps, m_wstModule);
break;
case EntryPointOldC :
m_pFunction = new WrapFunction(m_wstName, m_pOldFunc, m_pLoadDeps, m_wstModule);
break;
case EntryPointMex:
m_pFunction = new WrapMexFunction(m_wstName, m_pMexFunc, m_pLoadDeps, m_wstModule);
break;
case EntryPointC:
m_pFunction = new WrapCFunction(m_wstName, m_pCFunc, m_pLoadDeps, m_wstModule);
break;
}
if (m_pFunction == NULL)
{
return Error;
}
return OK;
}
/*--------------------------------------------------------------------------*/
int sci_getdate(char *fname, unsigned long fname_len)
{
SciErr sciErr;
Rhs = Max(Rhs, 0);
CheckRhs(0, 1) ;
CheckLhs(0, 1) ;
if (Rhs == 0)
{
int iErr = 0;
double *dDate = getCurrentDateAsDoubleVector(&iErr);
if (iErr)
{
Scierror(999, _("%s: An error occurred.\n"), fname);
if (dDate)
{
FREE(dDate);
dDate = NULL;
}
return 0;
}
if (dDate)
{
sciErr = createMatrixOfDouble(pvApiCtx, Rhs + 1, 1, NB_ELEMNT_ARRAY_GETDATE, dDate);
FREE(dDate);
dDate = NULL;
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
}
else
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
}
else /* Rhs == 1 */
{
int *piAddressVarOne = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (isStringType(pvApiCtx, piAddressVarOne))
{
if (isScalar(pvApiCtx, piAddressVarOne))
{
double dTime = 0.;
char *pStr = NULL;
if (getAllocatedSingleString(pvApiCtx, piAddressVarOne, &pStr) != 0)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 0;
}
if (strcmp(pStr, "s") != 0)
{
freeAllocatedSingleString(pStr);
pStr = NULL;
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' expected.\n"), fname, 1, "s");
return 0;
}
freeAllocatedSingleString(pStr);
pStr = NULL;
dTime = getCurrentDateAsUnixTimeConvention();
if (createScalarDouble(pvApiCtx, Rhs + 1, dTime) != 0)
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
}
else
{
Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 1);
return 0;
}
}
else if (isDoubleType(pvApiCtx, piAddressVarOne))
{
if (isEmptyMatrix(pvApiCtx, piAddressVarOne))
{
if (createEmptyMatrix(pvApiCtx, Rhs + 1) != 0)
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
}
else if (!isVarComplex(pvApiCtx, piAddressVarOne))
{
int iErr = 0;
double *dValues = NULL;
double *dResults = NULL;
int m = 0, n = 0;
int nbElements = 0;
int i = 0;
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &m, &n, &dValues);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
nbElements = m * n;
for (i = 0; i < nbElements; i++)
{
if (dValues[i] < 0.)
{
Scierror(999, _("%s: Wrong value for input argument #%d: Must be > %d.\n"), fname, 1, 0);
return 0;
}
}
dResults = getConvertedDateAsMatrixOfDouble(dValues, nbElements, &iErr);
if (iErr == 2)
{
FREE(dResults);
Scierror(999, _("%s: An error occurred.\n"), fname);
return 0;
}
if (dResults == NULL)
{
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
sciErr = createMatrixOfDouble(pvApiCtx, Rhs + 1, nbElements, NB_ELEMNT_ARRAY_GETDATE, dResults);
FREE(dResults);
dResults = NULL;
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 0;
}
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: A real expected.\n"), fname, 1);
return 0;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: Integer or '%s' expected.\n"), fname, 1, "s");
return 0;
}
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
/*------------------------------------------------------------------------*/
int set_current_axes_property(void* _pvCtx, int iObjUID, void* _pvData, int valueType, int nbRow, int nbCol)
{
int iCurAxesUID = 0;
int iCurChildUID = 0;
int iParentFigureUID = -1;
int* piParentFigureUID = &iParentFigureUID;
int type = -1;
int *piType = &type;
if (iObjUID != 0)
{
/* This property should not be called on a handle */
Scierror(999, _("'%s' property does not exist for this handle.\n"), "current_axes");
return SET_PROPERTY_ERROR;
}
if (valueType != sci_handles)
{
Scierror(999, _("Wrong type for '%s' property: Handle expected.\n"), "current_axes");
return SET_PROPERTY_ERROR;
}
iCurAxesUID = getObjectFromHandle((long)((long long*)_pvData)[0]);
if (iCurAxesUID == 0)
{
Scierror(999, _("Wrong value for '%s' property: Must be a valid handle.\n"), "current_entity");
return SET_PROPERTY_ERROR;
}
getGraphicObjectProperty(iCurAxesUID, __GO_TYPE__, jni_int, (void **)&piType);
if (type != __GO_AXES__)
{
Scierror(999, _("Wrong value for '%s' property: Must be a handle on axes.\n"), "current_axes");
return SET_PROPERTY_ERROR;
}
setCurrentSubWin(iCurAxesUID);
// Look for top level figure
type = -1;
iCurChildUID = iCurAxesUID;
do {
iParentFigureUID = getParentObject(iCurChildUID);
getGraphicObjectProperty(iParentFigureUID, __GO_TYPE__, jni_int, (void **)&piType);
iCurChildUID = iParentFigureUID;
} while (iParentFigureUID != -1 && type != __GO_FIGURE__);
/* The current Axes' parent Figure's selected child property must be updated */
setGraphicObjectProperty(iParentFigureUID, __GO_SELECTED_CHILD__, &iCurAxesUID, jni_int, 1);
/* F.Leray 11.02.05 : if the new selected subwin is not inside the current figure, */
/* we must also set the current figure to the subwin's parent */
if (!isCurrentFigure(iParentFigureUID))
{
setCurrentFigure(iParentFigureUID);
}
return SET_PROPERTY_SUCCEED;
}
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_dec2base(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int *piAddressVarOne = NULL;
int *piAddressVarTwo = NULL;
int m = 0, n = 0;
double *dValues = NULL;
char **convertedValues = NULL;
unsigned int iBaseUsed = 0;
double dBaseUsed = 0.;
unsigned int nbDigits = 0;
error_convertbase err = ERROR_CONVERTBASE_NOK;
CheckInputArgument(pvApiCtx, 2, 3);
CheckOutputArgument(pvApiCtx, 1, 1);
if (nbInputArgument(pvApiCtx) == 3)
{
double dParamThree = 0.;
unsigned int iParamThree = 0;
int *piAddressVarThree = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddressVarThree);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 3);
return 1;
}
if (!isDoubleType(pvApiCtx, piAddressVarThree))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar integer value expected.\n"), fname, 3);
return 1;
}
if (!isScalar(pvApiCtx, piAddressVarThree))
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar integer value expected.\n"), fname, 3);
return 1;
}
if (getScalarDouble(pvApiCtx, piAddressVarThree, &dParamThree) != 0)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 1;
}
iParamThree = (unsigned int)dParamThree;
if (dParamThree != (double)iParamThree)
{
Scierror(999, _("%s: Wrong value for input argument #%d: An integer value expected.\n"), fname, 3);
return 1;
}
nbDigits = iParamThree;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 1;
}
if (!isDoubleType(pvApiCtx, piAddressVarTwo))
{
Scierror(999, _("%s: Wrong type for input argument #%d: An integer value expected.\n"), fname, 2);
return 1;
}
if (!isScalar(pvApiCtx, piAddressVarTwo))
{
Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, 2);
return 1;
}
if (getScalarDouble(pvApiCtx, piAddressVarTwo, &dBaseUsed) != 0)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 1;
}
iBaseUsed = (unsigned int)dBaseUsed;
if (dBaseUsed != (double)iBaseUsed)
{
Scierror(999, _("%s: Wrong value for input argument #%d: An integer value expected.\n"), fname, 2);
return 1;
}
if (iBaseUsed < 2 || iBaseUsed > 36)
{
Scierror(999, _("%s: Wrong value for input argument #%d: Must be between %d and %d."), fname, 2, 2, 36);
return 1;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
if (isEmptyMatrix(pvApiCtx, piAddressVarOne))
{
if (createEmptyMatrix(pvApiCtx, nbInputArgument(pvApiCtx) + 1) != 0)
{
Scierror(999, _("%s: No more memory.\n"), fname);
return 1;
}
else
{
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
}
if (!isDoubleType(pvApiCtx, piAddressVarOne))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), fname, 1);
return 1;
}
if (isVarComplex(pvApiCtx, piAddressVarOne))
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), fname, 1);
return 1;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &m, &n , &dValues);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 1;
}
convertedValues = convertMatrixOfDec2Base(dValues, m * n, iBaseUsed, nbDigits, &err);
if ((err != ERROR_CONVERTBASE_OK) || (convertedValues == NULL))
{
freeArrayOfString(convertedValues, m * n);
convertedValues = NULL;
switch (err)
{
case ERROR_CONVERTBASE_NOT_INTEGER_VALUE:
Scierror(999, _("%s: Wrong value(s) for input argument #%d: A matrix of positive integer values expected.\n"), fname, 1);
return 1;
case ERROR_CONVERTBASE_NOT_IN_INTERVAL:
Scierror(999, _("%s: Wrong value for input argument #%d: Must be between 0 and 2^52.\n"), fname, 1);
return 1;
case ERROR_CONVERTBASE_ALLOCATION:
Scierror(999, _("%s: No more memory.\n"), fname);
return 1;
case ERROR_CONVERTBASE_NOK:
default:
Scierror(999, _("%s: Wrong value for input argument #%d: cannot convert value(s).\n"), fname, 1);
return 1;
}
}
sciErr = createMatrixOfString(pvApiCtx, nbInputArgument(pvApiCtx) + 1, m, n, (char const * const*) convertedValues);
freeArrayOfString(convertedValues, m * n);
convertedValues = NULL;
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Memory allocation error.\n"), fname);
return 1;
}
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_optim(types::typed_list &in, types::optional_list &opt, int _iRetCount, types::typed_list &out)
{
types::Function::ReturnValue ret = types::Function::Error;
OptimizationFunctions* opFunctionsManager = NULL;
types::Double* pDblX0 = NULL;
types::Double* pDblBinf = NULL;
types::Double* pDblBsub = NULL;
types::Double* pDblTi = NULL;
types::Double* pDblTd = NULL;
types::Double* pDblNap = NULL;
types::Double* pDblIter = NULL;
types::Double* pDblEpsg = NULL;
types::Double* pDblEpsf = NULL;
types::Double* pDblEpsx = NULL;
types::Double* pDblWork = NULL;
// types::Polynom* pPolyX0 = NULL;
// types::Polynom* pPolyBinf = NULL;
// types::Polynom* pPolyBsub = NULL;
int* piIzs = NULL;
int* piWork = NULL;
float* pfRzs = NULL;
double* pdblDzs = NULL;
double* pdblWork = NULL;
double* pdblWork2 = NULL;
double* pdblX0 = NULL;
double* pdblEpsx = NULL;
double* pdblG = NULL;
double* pdblVar = NULL;
double* pdblBsub = NULL;
double* pdblBinf = NULL;
bool bMem = false;
int iEpsx = 1;
int iDzs = 1;
int iIzs = 1;
int iPos = 0;
int iContr = 1;
int iSizeX0 = 0;
int iSizeBinf = 0;
int iSizeBsub = 0;
int iSim = 0; // 1 : c function || 2 : macro
int iAlgo = 1; // 1 : qn || 2 : gc || 10 : nd
int iMem = 0;
int iGetArgs = 0;
int iIndSim = 0;
int iIndOpt = 0;
int iSaveI = 0;
int iSaveD = 0;
int iArret = 0;
int iMode = 1;
int iWorkSize = 0;
int iWorkSizeI = 0;
int iNitv = 0;
int io = 0; // not used in scilab 6 and more
int iImp = 0;
int iZero = 0;
int iOne = 1;
double df0 = 1;
double dF = 0;
// stop arguments "ar"
int iNap = 100;
int iItMax = 100;
double dEpsg = NumericConstants::eps_machine; // p : eps*base
double dTol = dEpsg;
double dEpsf = 0;
try
{
if (in.size() < 2 || in.size() > 18)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "optim", 2, 18);
throw ast::ScilabException();
}
if (_iRetCount > 7)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d to %d expected.\n"), "optim", 1, 7);
throw ast::ScilabException();
}
/*** get inputs arguments ***/
// get optionals
for (const auto& o : opt)
{
// "imp"
if (o.first == L"imp")
{
if (o.second->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%s: A scalar expected.\n"), "optim", "imp");
throw ast::ScilabException();
}
types::Double* pDblImp = o.second->getAs<types::Double>();
if (pDblImp->isScalar() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%s: A scalar expected.\n"), "optim", "imp");
throw ast::ScilabException();
}
iImp = (int)pDblImp->get(0);
}
// "nap"
else if (o.first == L"nap")
{
if (o.second->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%s: A real scalar expected.\n"), "optim", "nap");
throw ast::ScilabException();
}
pDblNap = o.second->getAs<types::Double>();
if (pDblNap->isScalar() == false || pDblNap->isComplex())
{
Scierror(999, _("%s: Wrong size for input argument #%s: A real scalar expected.\n"), "optim", "nap");
throw ast::ScilabException();
}
iNap = (int)pDblNap->get(0);
}
// "iter"
else if (o.first == L"iter")
{
if (o.second->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%s: A real scalar expected.\n"), "optim", "iter");
throw ast::ScilabException();
}
pDblIter = o.second->getAs<types::Double>();
if (pDblIter->isScalar() == false || pDblIter->isComplex())
{
Scierror(999, _("%s: Wrong size for input argument #%s: A real scalar expected.\n"), "optim", "iter");
throw ast::ScilabException();
}
iItMax = (int)pDblIter->get(0);
}
// "epsg"
else if (o.first == L"epsg")
{
if (o.second->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%s: A real scalar expected.\n"), "optim", "epsg");
throw ast::ScilabException();
}
pDblEpsg = o.second->getAs<types::Double>();
if (pDblEpsg->isScalar() == false || pDblEpsg->isComplex())
{
Scierror(999, _("%s: Wrong size for input argument #%s: A real scalar expected.\n"), "optim", "epsg");
throw ast::ScilabException();
}
dEpsg = pDblEpsg->get(0);
}
// "epsf"
else if (o.first == L"epsf")
{
if (o.second->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%s: A real scalar expected.\n"), "optim", "epsf");
throw ast::ScilabException();
}
pDblEpsf = o.second->getAs<types::Double>();
if (pDblEpsf->isScalar() == false || pDblEpsf->isComplex())
{
Scierror(999, _("%s: Wrong size for input argument #%s: A real scalar expected.\n"), "optim", "epsf");
throw ast::ScilabException();
}
dEpsf = pDblEpsf->get(0);
}
// "epsx"
else if (o.first == L"epsx")
{
if (o.second->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%s: A real scalar expected.\n"), "optim", "epsx");
throw ast::ScilabException();
}
pDblEpsx = o.second->getAs<types::Double>();
iEpsx = 0;
pdblEpsx = pDblEpsx->get();
}
}
// get costf
opFunctionsManager = new OptimizationFunctions(L"optim");
Optimization::addOptimizationFunctions(opFunctionsManager);
if (in[iPos]->isCallable())
{
types::Callable* pCall = in[iPos]->getAs<types::Callable>();
opFunctionsManager->setOptimCostfFunction(pCall);
iSim = 2;
}
else if (in[iPos]->isString())
{
types::String* pStr = in[iPos]->getAs<types::String>();
char* pst = wide_string_to_UTF8(pStr->get(0));
bool bOK = opFunctionsManager->setOptimCostfFunction(pStr);
iSim = 1;
if (bOK == false)
{
Scierror(50, _("%s: Subroutine not found: %s\n"), "optim", pst);
FREE(pst);
throw ast::ScilabException();
}
memcpy(C2F(optim).nomsub, pst, std::max(size_t(6), strlen(pst)));
FREE(pst);
}
else if (in[iPos]->isList())
{
types::List* pList = in[iPos]->getAs<types::List>();
if (pList->getSize() == 0)
{
Scierror(50, _("%s: Argument #%d: Subroutine not found in list: %s\n"), "optim", iPos + 1, "(string empty)");
throw ast::ScilabException();
}
if (pList->get(0)->isString())
{
types::String* pStr = pList->get(0)->getAs<types::String>();
char* pst = wide_string_to_UTF8(pStr->get(0));
bool bOK = opFunctionsManager->setOptimCostfFunction(pStr);
iSim = 1;
if (bOK == false)
{
Scierror(50, _("%s: Subroutine not found: %s\n"), "optim", pst);
FREE(pst);
throw ast::ScilabException();
}
memcpy(C2F(optim).nomsub, pst, std::max(size_t(6), strlen(pst)));
FREE(pst);
}
else if (pList->get(0)->isCallable())
{
types::Callable* pCall = pList->get(0)->getAs<types::Callable>();
opFunctionsManager->setOptimCostfFunction(pCall);
iSim = 2;
for (int iter = 1; iter < pList->getSize(); iter++)
{
opFunctionsManager->setCostfArgs(pList->get(iter)->getAs<types::InternalType>());
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: The first argument in the list must be a string or a function.\n"), "optim", iPos + 1);
throw ast::ScilabException();
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix or a function expected.\n"), "optim", iPos + 1);
throw ast::ScilabException();
}
iPos++;
// if contr, get binf and bsup
if (in[iPos]->isString())
{
types::String* pStrContr = in[iPos]->getAs<types::String>();
if (pStrContr->isScalar() == false || wcscmp(pStrContr->get(0), L"b"))
{
Scierror(999, _("%s: Wrong type for input argument #%d: String \"b\" expected.\n"), "optim", iPos + 1);
throw ast::ScilabException();
}
if (in.size() < 5)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d or more expected.\n"), "optim", 5);
throw ast::ScilabException();
}
iPos++;
if (in[iPos]->isDouble())
{
pDblBinf = in[iPos]->getAs<types::Double>();
iSizeBinf = pDblBinf->getSize();
pdblBinf = pDblBinf->get();
}
// else if(in[iPos]->isPoly())
// {
// pPolyBinf = in[iPos]->getAs<types::Polynom>();
// iSizeBinf = pPolyBinf->getSize();
// }
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix or polynom expected.\n"), "optim", iPos + 1);
throw ast::ScilabException();
}
iPos++;
if (in[iPos]->isDouble())
{
pDblBsub = in[iPos]->getAs<types::Double>();
iSizeBsub = pDblBsub->getSize();
pdblBsub = pDblBsub->get();
}
// else if(in[iPos]->isPoly())
// {
// pPolyBsub = in[iPos]->getAs<types::Polynom>();
// iSizeBsub = pPolyBsub->getSize();
// }
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix or polynom expected.\n"), "optim", iPos + 1);
throw ast::ScilabException();
}
iContr = 2;
iPos++;
}
// get x0
if (in[iPos]->isDouble())
{
pDblX0 = in[iPos]->getAs<types::Double>();
iSizeX0 = pDblX0->getSize();
if (pDblX0->isComplex())
{
iSizeX0 *= 2;
pdblX0 = new double[iSizeX0];
memcpy(pdblX0, pDblX0->get(), pDblX0->getSize() * sizeof(double));
memcpy(pdblX0 + pDblX0->getSize(), pDblX0->getImg(), pDblX0->getSize() * sizeof(double));
}
else
{
pdblX0 = new double[iSizeX0];
memcpy(pdblX0, pDblX0->get(), pDblX0->getSize() * sizeof(double));
}
opFunctionsManager->setXRows(pDblX0->getRows());
opFunctionsManager->setXCols(pDblX0->getCols());
}
// else if(in[iPos]->isPoly())
// {
//
// }
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix or polynom expected.\n"), "optim", iPos + 1);
throw ast::ScilabException();
}
if (iContr == 2 && (iSizeX0 != iSizeBinf || iSizeX0 != iSizeBsub))
{
Scierror(999, _("%s: Bounds and initial guess are incompatible.\n"), "optim");
throw ast::ScilabException();
}
if (pDblEpsx != NULL && (pDblEpsx->getSize() != iSizeX0))
{
Scierror(999, _("%s: Wrong value for input argument #%s: Incorrect stopping parameters.\n"), "optim", "epsx");
throw ast::ScilabException();
}
// alloc g output data
pdblG = new double[iSizeX0];
iPos++;
// get algo
if (iPos < in.size() && in[iPos]->isString())
{
types::String* pStr = in[iPos]->getAs<types::String>();
if (pStr->isScalar() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Scalar string expected.\n"), "optim", iPos + 1);
throw ast::ScilabException();
}
if (wcscmp(pStr->get(0), L"qn") == 0) // default case
{
iAlgo = 1;
iPos++;
}
else if (wcscmp(pStr->get(0), L"gc") == 0)
{
iAlgo = 2;
iPos++;
}
else if (wcscmp(pStr->get(0), L"nd") == 0)
{
iAlgo = 10;
iPos++;
}
// else
// {
// Scierror(999, _("%s: Wrong value for input argument #%d: \"qn\", \"gc\", \"nd\" expected.\n"), "optim", iPos + 1);
// throw ast::ScilabException();
// }
}
// get df0 and mem
if (iPos < in.size() && in[iPos]->isDouble() && in[iPos]->getAs<types::Double>()->isScalar())
{
df0 = in[iPos]->getAs<types::Double>()->get(0);
iPos++;
// get mem
if (iPos < in.size() && iContr == 1 && (iAlgo == 2 || iAlgo == 10) && in[iPos]->isDouble())
{
types::Double* pDbl = in[iPos]->getAs<types::Double>();
if (in[iPos]->isDouble() && pDbl->isScalar() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "optim", iPos + 1);
throw ast::ScilabException();
}
iMem = (int)pDbl->get(0);
bMem = true;
iPos++;
}
}
// management of work table
if (iAlgo == 1)
{
// compute size
if (iContr == 1)
{
iWorkSize = (int)(iSizeX0 * ((iSizeX0 + 13) / 2.0));
iWorkSizeI = 0;
}
else // iContr == 2
{
iWorkSize = (int)(iSizeX0 * (iSizeX0 + 1) / 2.0 + 4 * iSizeX0 + 1);
iWorkSizeI = 2 * iSizeX0;
}
/* See bug #9701 for this hard-coded value */
/* Fortran underlying algorithm does not support values higher than 46333 */
if (iSizeX0 > 46333)
{
Scierror(999, _("Can not allocate %.2f MB memory.\n"), (double)(iWorkSize * sizeof(double)) / 1.e6);
delete[] pdblG;
delete[] pdblX0;
return types::Function::Error;
}
try
{
// alloc data
pdblWork = new double[iWorkSize];
if (iContr == 2)
{
piWork = new int[iWorkSizeI];
}
}
catch (std::bad_alloc& /*ba*/)
{
Scierror(999, _("Can not allocate %.2f MB memory.\n"), (double)(iWorkSize * sizeof(double)) / 1.e6);
delete[] pdblG;
delete[] pdblX0;
return types::Function::Error;
}
}
// get work
if (iPos < in.size() && in[iPos]->isDouble())
{
if (iAlgo != 1)
{
Scierror(137, _("%s: NO hot restart available in this method.\n"), "optim");
throw ast::ScilabException();
}
pDblWork = in[iPos]->getAs<types::Double>();
if (pDblWork->getSize() != iWorkSize + iWorkSizeI)
{
Scierror(137, _("Hot restart: dimension of working table (argument n:%d).\n"), "optim", iPos + 1);
throw ast::ScilabException();
}
double* pdbl = pDblWork->get();
if (iContr == 1)
{
C2F(dcopy)(&iWorkSize, pdbl, &iOne, pdblWork, &iOne);
}
else
{
C2F(dcopy)(&iWorkSize, pdbl, &iOne, pdblWork, &iOne);
for (int i = 0; i < iWorkSizeI; i++)
{
piWork[i] = (int)pdbl[i];
}
}
iMode = 3;
iPos++;
}
// get stop
while (iPos < in.size() && in[iPos]->isString())
{
types::String* pStr = in[iPos]->getAs<types::String>();
if (wcscmp(pStr->get(0), L"ar") == 0)
{
iPos++;
for (int i = iPos; i < in.size(); i++)
{
// get nap, iter, epsg, apsf, epsx
if (in[i]->isDouble())
{
if (pDblNap == NULL)
{
pDblNap = in[i]->getAs<types::Double>();
if (pDblNap->isScalar() == false || pDblNap->isComplex())
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), "optim", i + 1);
throw ast::ScilabException();
}
iNap = (int)pDblNap->get(0);
}
else if (pDblIter == NULL)
{
pDblIter = in[i]->getAs<types::Double>();
if (pDblIter->isScalar() == false || pDblIter->isComplex())
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), "optim", i + 1);
throw ast::ScilabException();
}
iItMax = (int)pDblIter->get(0);
}
else if (pDblEpsg == NULL)
{
pDblEpsg = in[i]->getAs<types::Double>();
if (pDblEpsg->isScalar() == false || pDblEpsg->isComplex())
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), "optim", i + 1);
throw ast::ScilabException();
}
dEpsg = pDblEpsg->get(0);
}
else if (pDblEpsf == NULL)
{
pDblEpsf = in[i]->getAs<types::Double>();
if (pDblEpsf->isScalar() == false || pDblEpsf->isComplex())
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real scalar expected.\n"), "optim", i + 1);
throw ast::ScilabException();
}
dEpsf = pDblEpsf->get(0);
}
else if (pDblEpsx == NULL)
{
pDblEpsx = in[i]->getAs<types::Double>();
if (pDblEpsx->getSize() != iSizeX0)
{
Scierror(999, _("%s: Wrong value for input argument #%d: Incorrect stopping parameters.\n"), "optim", i + 1);
throw ast::ScilabException();
}
iEpsx = 0;
pdblEpsx = pDblEpsx->get();
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A String expected.\n"), "optim", i + 1);
throw ast::ScilabException();
}
}
else if (in[i]->isString())
{
iPos = i - 1;
break;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar of a string expected.\n"), "optim", i + 1);
throw ast::ScilabException();
}
}
}
else if (wcscmp(pStr->get(0), L"in") == 0)
{
if (iSim != 1)
{
Scierror(999, _("%s: \"in\" not allowed with simulator defined by a function.\n"), "optim");
throw ast::ScilabException();
}
iIndSim = 10;
costf(&iIndSim, &iSizeX0, pDblX0->get(), &dF, pdblG, NULL, NULL, NULL);
if (iIndSim == 0)
{
Scierror(131, _("%s: Stop requested by simulator (ind=0).\n"), "optim");
throw ast::ScilabException();
}
else if (iIndSim < 0)
{
Scierror(134, _("%s: Problem with initial constants in simul.\n"), "optim");
throw ast::ScilabException();
}
piIzs = new int[C2F(nird).nizs];
pfRzs = new float[C2F(nird).nrzs];
pdblDzs = new double[C2F(nird).ndzs];
iIndSim = 11;
costf(&iIndSim, &iSizeX0, pDblX0->get(), &dF, pdblG, piIzs, pfRzs, pdblDzs);
if (iIndSim == 0)
{
Scierror(131, _("%s: Stop requested by simulator (ind=0).\n"), "optim");
throw ast::ScilabException();
}
else if (iIndSim < 0)
{
Scierror(134, _("%s: Problem with initial constants in simul.\n"), "optim");
throw ast::ScilabException();
}
}
else if (wcscmp(pStr->get(0), L"ti") == 0)
{
iPos++;
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "optim", iPos + 1);
throw ast::ScilabException();
}
pDblTi = in[iPos]->getAs<types::Double>();
C2F(nird).nizs = pDblTi->getSize();
piIzs = new int[pDblTi->getSize()];
for (int i = 0; i < pDblTi->getSize(); i++)
{
piIzs[i] = (int)pDblTi->get(i);
}
iIzs = 0;
}
else if (wcscmp(pStr->get(0), L"td") == 0)
{
iPos++;
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "optim", iPos + 1);
throw ast::ScilabException();
}
pDblTd = in[iPos]->getAs<types::Double>();
C2F(nird).ndzs = pDblTd->getSize();
pdblDzs = pDblTd->get();
iDzs = 0;
}
else if (wcscmp(pStr->get(0), L"si") == 0)
{
iSaveI = 1;
}
else if (wcscmp(pStr->get(0), L"sd") == 0)
{
iSaveD = 1;
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: \"ar\", \"in\", \"ti\" or \"td\" not allowed.\n"), "optim", iPos + 1);
throw ast::ScilabException();
}
iPos++;
}
// initialisation eventuelle de f et g
if (iNap < 2 || iItMax < 1)
{
iArret = 1;
}
if (iContr == 1 && (iAlgo == 2 || iAlgo == 10) ||
(iContr == 2 && iAlgo == 1 && pdblWork) ||
(iArret == 1))
{
iIndSim = 4;
costf(&iIndSim, &iSizeX0, pDblX0->get(), &dF, pdblG, piIzs, pfRzs, pdblDzs);
if (iIndSim == 0)
{
Scierror(131, _("%s: Stop requested by simulator (ind=0).\n"), "optim");
throw ast::ScilabException();
}
else if (iIndSim < 0)
{
Scierror(134, _("%s: Problem with initial constants in simul.\n"), "optim");
throw ast::ScilabException();
}
if (iNap < 2 || iItMax < 1)
{
// skip perform operation part
iContr = 3;
}
}
/*** perform operations ***/
// n1qn1 : Quasi-Newton without constraints
if (iContr == 1 && iAlgo == 1) // bounds not setted && algo qn
{
pdblVar = new double[iSizeX0];
for (int i = 0; i < iSizeX0; i++)
{
pdblVar[i] = 0.10;
}
int iItmax1 = iItMax;
int iNap1 = iNap;
double dEpsg1 = dEpsg;
C2F(n1qn1)(costf, &iSizeX0, pdblX0, &dF, pdblG,
pdblVar, &dEpsg, &iMode, &iItMax, &iNap, &iImp, &io, pdblWork,
piIzs, pfRzs, pdblDzs);
dEpsg = sqrt(dEpsg);
iIndOpt = 9;
if (dEpsg1 >= dEpsg)
{
iIndOpt = 1;
}
else if (iNap >= iNap1)
{
iIndOpt = 4;
}
else if (iItMax >= iItmax1)
{
iIndOpt = 5;
}
if (checkOptimError(iArret, iIndOpt, iImp, dEpsg))
{
throw ast::ScilabException();
}
}
// algorithme n1qn3 : Gradient Conjugate without constraints
else if (iContr == 1 && iAlgo == 2) // bounds not setted && algo gc
{
double dxmin = dEpsg;
double dZng = 0;
if (bMem == false)
{
iMem = 10;
}
// compute epsrel
for (int i = 0; i < iSizeX0; i++)
{
dZng += (pdblG[i] * pdblG[i]);
}
dZng = sqrt(dZng);
if (dZng > 0)
{
dEpsg /= dZng;
}
// compute dxmin
if (iEpsx == 0)
{
dxmin = pdblEpsx[0];
if (iSizeX0 > 1)
{
for (int i = 0; i < iSizeX0; i++)
{
dxmin = std::min(dxmin, pdblEpsx[i]);
}
}
}
// work table
iWorkSize = 4 * iSizeX0 + iMem * (2 * iSizeX0 + 1);
pdblWork = new double[iWorkSize];
iIndSim = 4;
costf(&iIndSim, &iSizeX0, pDblX0->get(), &dF, pdblG, piIzs, pfRzs, pdblDzs);
C2F(n1qn3)( costf, C2F(fuclid), C2F(ctonb), C2F(ctcab), &iSizeX0, pdblX0,
&dF, pdblG, &dxmin, &df0, &dEpsg, &iImp, &io, &iMode, &iItMax,
&iNap, pdblWork, &iWorkSize, piIzs, pfRzs, pdblDzs);
switch (iMode)
{
case 0 :
iIndOpt = 0;
break;
case 1 :
iIndOpt = 1;
break;
case 2 :
iIndOpt = -10;
break;
case 7 :
case 3 :
iIndOpt = 7;
break;
case 4 :
iIndOpt = 5;
break;
case 5 :
iIndOpt = 4;
break;
case 6 :
iIndOpt = 3;
break;
default :
iIndOpt = 9;
}
if (checkOptimError(iArret, iIndOpt, iImp, dEpsg))
{
throw ast::ScilabException();
}
}
// optimiseur n1fc1 : non smooth without constraints
else if (iContr == 1 && iAlgo == 10) // bounds not setted && algo nd
{
if (bMem == false)
{
iMem = 10;
}
int iNitv = 2 * iMem + 2;
int iNtv1 = 5 * iSizeX0 + (iSizeX0 + 4) * iMem;
int iNtv2 = (iMem + 9) * iMem + 8;
piWork = new int[iNitv];
pdblWork = new double[iNtv1];
pdblWork2 = new double[iNtv2];
if (iEpsx == 1)
{
pdblEpsx = new double[iSizeX0];
C2F(dcopy)(&iSizeX0, &dTol, &iZero, pdblEpsx, &iOne);
}
C2F(n1fc1)(costf, C2F(fuclid), &iSizeX0, pdblX0, &dF, pdblG,
pdblEpsx, &df0, &dEpsf, &dTol, &iImp, &io, &iMode,
&iItMax, &iNap, &iMem, piWork, pdblWork, pdblWork2,
piIzs, pfRzs, pdblDzs);
switch (iMode)
{
case 0 :
iIndOpt = 0;
break;
case 1 :
iIndOpt = 2;
break;
case 2 :
iIndOpt = -10;
break;
case 4 :
iIndOpt = 5;
break;
case 5 :
iIndOpt = 4;
break;
case 6 :
iIndOpt = 3;
break;
default :
iIndOpt = 9;
}
if (checkOptimError(iArret, iIndOpt, iImp, dEpsg))
{
throw ast::ScilabException();
}
}
// optimiseur qnbd : quasi-newton with bound constraints
else if (iContr == 2 && iAlgo == 1) // bounds setted && algo qn
{
int iNfac = 0;
if (iEpsx == 1)
{
pdblEpsx = new double[iSizeX0];
C2F(dcopy)(&iSizeX0, &dTol, &iZero, pdblEpsx, &iOne);
}
iIndOpt = 1 + pDblWork ? 1 : 0;
C2F(qnbd)(&iIndOpt, costf, &iSizeX0, pdblX0, &dF, pdblG, &iImp, &io, &dTol, &iNap,
&iItMax, &dEpsf, &dEpsg, pdblEpsx, &df0, pdblBinf, pdblBsub,
&iNfac, pdblWork, &iWorkSize, piWork, &iWorkSizeI, piIzs, pfRzs, pdblDzs);
if (checkOptimError(iArret, iIndOpt, iImp, dEpsg))
{
throw ast::ScilabException();
}
}
// optimiseur gcbd : Gradient Conjugate with bound constraints
else if (iContr == 2 && iAlgo == 2) // bounds setted && algo gc
{
int iNfac = 0;
int nt = 2;
if (bMem)
{
nt = std::max(1, iMem / 3);
}
iWorkSize = iSizeX0 * (5 + 3 * nt) + 2 * nt + 1;
iWorkSizeI = iSizeX0 + nt + 1;
pdblWork = new double[iWorkSize];
piWork = new int[iWorkSizeI];
if (iEpsx == 1)
{
pdblEpsx = new double[iSizeX0];
C2F(dcopy)(&iSizeX0, &dTol, &iZero, pdblEpsx, &iOne);
}
iIndOpt = 1;
C2F(gcbd)(&iIndOpt, costf, C2F(optim).nomsub, &iSizeX0, pdblX0, &dF, pdblG,
&iImp, &io, &dTol, &iNap, &iItMax, &dEpsf, &dEpsg, pdblEpsx, &df0,
pdblBinf, pdblBsub, &iNfac, pdblWork, &iWorkSize, piWork, &iWorkSizeI,
piIzs, pfRzs, pdblDzs);
if (checkOptimError(iArret, iIndOpt, iImp, dEpsg))
{
throw ast::ScilabException();
}
}
else if (iContr != 3) // bad algo
{
Scierror(136, _("%s: This method is NOT implemented.\n"), "optim");
throw ast::ScilabException();
}
/*** return output arguments ***/
int iRetCount1 = _iRetCount - iSaveI - iSaveD;
if (iRetCount1 == 0)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d to %d expected.\n"), "optim", iSaveI + iSaveD, iSaveI + iSaveD + 1);
throw ast::ScilabException();
}
// return f
out.push_back(new types::Double(dF));
// return x
if (iRetCount1 >= 2)
{
if (pDblX0)
{
types::Double* pDbl = new types::Double(pDblX0->getDims(), pDblX0->getDimsArray(), pDblX0->isComplex());
double* pdblReal = pDbl->get();
memcpy(pdblReal, pdblX0, pDbl->getSize() * sizeof(double));
if (pDbl->isComplex())
{
double* pdblImg = pDbl->getImg();
memcpy(pdblImg, pdblX0 + pDbl->getSize(), pDbl->getSize() * sizeof(double));
}
out.push_back(pDbl);
}
// else // if (pPolyX0)
// {
//
// }
}
// return g
if (iRetCount1 >= 3)
{
if (pdblG)
{
types::Double* pDbl = new types::Double(pDblX0->getDims(), pDblX0->getDimsArray(), pDblX0->isComplex());
double* pdblReal = pDbl->get();
memcpy(pdblReal, pdblG, pDbl->getSize() * sizeof(double));
if (pDbl->isComplex())
{
double* pdblImg = pDbl->getImg();
memcpy(pdblImg, pdblG + pDbl->getSize(), pDbl->getSize() * sizeof(double));
}
out.push_back(pDbl);
}
// else // if (pPolyX0)
// {
//
// }
}
// return work
if (iRetCount1 >= 4)
{
if (iAlgo != 1)
{
Scierror(137, _("%s: NO hot restart available in this method.\n"), "optim");
throw ast::ScilabException();
}
if (iContr == 1)
{
types::Double* pDbl = new types::Double(1, iWorkSize);
double* pdbl = pDbl->get();
C2F(dcopy)(&iWorkSize, pdblWork, &iOne, pdbl, &iOne);
out.push_back(pDbl);
}
else if (iContr == 2)
{
types::Double* pDbl = new types::Double(1, iWorkSize + iWorkSizeI);
double* pdbl = pDbl->get();
C2F(dcopy)(&iWorkSize, pdblWork, &iOne, pdbl, &iOne);
for (int i = iWorkSize; i < iWorkSize + iWorkSizeI; i++)
{
pdbl[i] = (double)(piWork[i]);
}
out.push_back(pDbl);
}
else // iContr == 3
{
out.push_back(pDblWork->clone());
}
}
if (iRetCount1 >= 5)
{
out.push_back(new types::Double((double)iItMax));
}
if (iRetCount1 >= 6)
{
out.push_back(new types::Double((double)iNap));
}
if (iRetCount1 >= 7)
{
out.push_back(new types::Double((double)iIndOpt));
}
if (iSaveI)
{
if (C2F(nird).nizs == 0)
{
out.push_back(types::Double::Empty());
}
else
{
types::Double* pDbl = new types::Double(1, C2F(nird).nizs);
double* pdbl = pDbl->get();
for (int i = 0; i < C2F(nird).nizs; i++)
{
pdbl[i] = (double)piIzs[i];
}
out.push_back(pDbl);
}
}
if (iSaveD)
{
if (C2F(nird).ndzs == 0)
{
out.push_back(types::Double::Empty());
}
else
{
types::Double* pDbl = new types::Double(1, C2F(nird).ndzs);
memcpy(pDbl->get(), pdblDzs, C2F(nird).ndzs * sizeof(double));
out.push_back(pDbl);
}
}
ret = types::Function::OK;
}
catch (const ast::InternalError& e)
{
char* pstrMsg = wide_string_to_UTF8(e.GetErrorMessage().c_str());
Scierror(999, pstrMsg);
FREE(pstrMsg);
}
catch (const ast::ScilabException& /* e */)
{
// free memory, then return error
}
/*** free memory ***/
if (opFunctionsManager)
{
Optimization::removeOptimizationFunctions();
}
if (piIzs && iIzs)
{
delete[] piIzs;
}
if (pfRzs)
{
delete[] pfRzs;
}
if (pdblG)
{
delete[] pdblG;
}
if (pdblDzs && iDzs)
{
delete[] pdblDzs;
}
if (pdblWork)
{
delete[] pdblWork;
}
if (pdblWork2)
{
delete[] pdblWork2;
}
if (piWork)
{
delete[] piWork;
}
if (pdblX0)
{
delete[] pdblX0;
}
if (pdblVar)
{
delete[] pdblVar;
}
if (pdblEpsx && iEpsx)
{
delete[] pdblEpsx;
}
return ret;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_varn(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
types::Polynom* pPolyIn = NULL;
types::String* pStrName = NULL;
types::Polynom* pPolyOut = NULL;
if (in.size() < 1 || in.size() > 2)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "varn", 1, 2);
return types::Function::Error;
}
if (_iRetCount > 1)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "varn", 1);
return types::Function::Error;
}
if (in[0]->isPoly() == false)
{
if (in[0]->isDouble() && in[0]->getAs<types::Double>()->isEmpty())
{
out.push_back(types::Double::Empty());
return types::Function::OK;
}
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_varn";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
pPolyIn = in[0]->getAs<types::Polynom>();
if (in.size() == 1)
{
out.push_back(new types::String(pPolyIn->getVariableName().c_str()));
}
else // if (in.size() == 2)
{
if (in[1]->isString() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : string expected.\n"), "varn", 2);
return types::Function::Error;
}
pStrName = in[1]->getAs<types::String>();
if (pStrName->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d : A scalar expected.\n"), "varn", 2);
return types::Function::Error;
}
std::wstring wstrName = pStrName->get(0);
// search blank
size_t blankpos = wstrName.find_first_of(L" ");
if ((int)blankpos != -1)
{
// blank found
Scierror(999, _("%s: Wrong value for input argument #%d : Valid variable name expected.\n"), "varn", 2);
return types::Function::Error;
}
pPolyOut = pPolyIn->clone()->getAs<types::Polynom>();
pPolyOut->setVariableName(std::wstring(wstrName));
out.push_back(pPolyOut);
}
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
int sci_export_to_hdf5(char *fname, unsigned long fname_len)
{
int iNbVar = 0;
int** piAddrList = NULL;
char** pstNameList = NULL;
char *pstFileName = NULL;
bool bExport = true;
bool bAppendMode = false;
SciErr sciErr;
int iRhs = nbInputArgument(pvApiCtx);
CheckInputArgumentAtLeast(pvApiCtx, 1);
CheckOutputArgument(pvApiCtx, 0, 1);
pstNameList = (char**)MALLOC(sizeof(char*) * iRhs);
iNbVar = extractVarNameList(1, iRhs, pstNameList);
if (iNbVar == 0)
{
FREE(pstNameList);
return 1;
}
piAddrList = (int**)MALLOC(sizeof(int*) * (iNbVar));
for (int i = 1 ; i < iRhs ; i++)
{
if (strcmp(pstNameList[i], "-append") == 0)
{
bAppendMode = true;
}
else
{
sciErr = getVarAddressFromName(pvApiCtx, pstNameList[i], &piAddrList[i]);
if (sciErr.iErr)
{
Scierror(999, _("%s: Wrong value for input argument #%d: Defined variable expected.\n"), fname, i + 1);
printError(&sciErr, 0);
return 1;
}
}
}
iLevel = 0;
// open hdf5 file
pstFileName = expandPathVariable(pstNameList[0]);
int iH5File = 0;
if (bAppendMode)
{
iH5File = openHDF5File(pstFileName, bAppendMode);
if (iH5File < 0)
{
iH5File = createHDF5File(pstFileName);
}
}
else
{
iH5File = createHDF5File(pstFileName);
}
if (iH5File < 0)
{
FREE(pstFileName);
if (iH5File == -2)
{
Scierror(999, _("%s: Wrong value for input argument #%d: \"%s\" is a directory"), fname, 1, pstNameList[0]);
}
else
{
Scierror(999, _("%s: Cannot open file %s.\n"), fname, pstNameList[0]);
}
return 1;
}
if (bAppendMode)
{
int iVersion = getSODFormatAttribute(iH5File);
if (iVersion != -1 && iVersion != SOD_FILE_VERSION)
{
//to update version must be the same
closeHDF5File(iH5File);
Scierror(999, _("%s: Wrong SOD file format version. Expected: %d Found: %d\n"), fname, SOD_FILE_VERSION, iVersion);
return 1;
}
}
// export data
for (int i = 1 ; i < iRhs ; i++)
{
if (strcmp(pstNameList[i], "-append") == 0)
{
continue;
}
if (isVarExist(iH5File, pstNameList[i]))
{
if (bAppendMode)
{
if (deleteHDF5Var(iH5File, pstNameList[i]))
{
closeHDF5File(iH5File);
Scierror(999, _("%s: Unable to delete existing variable \"%s\"."), fname, pstNameList[i]);
return 1;
}
}
else
{
closeHDF5File(iH5File);
Scierror(999, _("%s: Variable \'%s\' already exists in file \'%s\'\nUse -append option to replace existing variable\n."), fname, pstNameList[i], pstNameList[0]);
return 1;
}
}
bExport = export_data(iH5File, piAddrList[i], pstNameList[i]);
if (bExport == false)
{
break;
}
}
if (bExport && iRhs != 1)
{
//add or update scilab version and file version in hdf5 file
if (updateScilabVersion(iH5File) < 0)
{
closeHDF5File(iH5File);
Scierror(999, _("%s: Unable to update Scilab version in \"%s\"."), fname, pstNameList[0]);
return 1;
}
if (updateFileVersion(iH5File) < 0)
{
closeHDF5File(iH5File);
Scierror(999, _("%s: Unable to update HDF5 format version in \"%s\"."), fname, pstNameList[0]);
return 1;
}
}
//close hdf5 file
closeHDF5File(iH5File);
//delete file in case of error but nor in append mode
if (bExport == false && bAppendMode == false && iRhs != 1)
{
//remove file
deleteafile(pstFileName);
}
FREE(pstFileName);
//create boolean return value
int *piReturn = NULL;
sciErr = allocMatrixOfBoolean(pvApiCtx, iRhs + 1, 1, 1, &piReturn);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (bExport == true || iRhs == 1)
{
piReturn[0] = 1;
}
else
{
piReturn[0] = 0;
}
//free memory
for (int i = 0 ; i < iRhs ; i++)
{
FREE(pstNameList[i]);
}
FREE(pstNameList);
FREE(piAddrList);
LhsVar(1) = iRhs + 1;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_typename_two_rhs(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int m1 = 0, n1 = 0;
int iType1 = 0;
int *piAddressVarOne = NULL;
char *pStVarOne = NULL;
int lenStVarOne = 0;
int m2 = 0, n2 = 0;
int iType2 = 0;
int *piAddressVarTwo = NULL;
double *pdVarTwo = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarOne, &iType1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarTwo, &iType2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 0;
}
if ( iType1 != sci_strings )
{
Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), fname, 1);
return 0;
}
if ( iType2 != sci_matrix )
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), fname, 2);
return 0;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo, &m2, &n2, &pdVarTwo);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
return 0;
}
if ( (m2 != n2) && (n2 != 1) )
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), fname, 2);
return 0;
}
sciErr = getMatrixOfString(pvApiCtx, piAddressVarOne, &m1, &n1, &lenStVarOne, &pStVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if ( (m1 != n1) && (n1 != 1) )
{
Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, 1);
return 0;
}
pStVarOne = (char*)MALLOC(sizeof(char) * (lenStVarOne + 1));
sciErr = getMatrixOfString(pvApiCtx, piAddressVarOne, &m1, &n1, &lenStVarOne, &pStVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
if (pStVarOne)
{
int ierr = 0;
sciErr = getMatrixOfString(pvApiCtx, piAddressVarOne, &m1, &n1, &lenStVarOne, &pStVarOne);
if (sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
return 0;
}
ierr = addNamedType(pStVarOne, (int)pdVarTwo[0]);
switch (ierr)
{
case -1 :
Scierror(999, _("%s: '%s' already exists.\n"), fname, pStVarOne);
break;
case 0:
LhsVar(1) = 0;
PutLhsVar();
break;
break;
case 1:
case 3:
SciError(224);
break;
case 2:
SciError(225);
break;
default:
/* never here */
Scierror(999, _("%s: Unknown Error.\n"), fname);
break;
}
FREE(pStVarOne);
pStVarOne = NULL;
}
else
{
Scierror(999, _("%s: No more memory.\n"), fname);
}
return 0;
}
/* ==================================================================== */
int sci_edftell(char *fname)
{
SciErr sciErr;
int m1 = 0, n1 = 0;
int *piAddressVarOne = NULL;
//int* piLenVarOne = NULL;
//char **fileData = NULL;
double *pdVarOne = NULL;
int iType1 = 0;
int m2 = 0, n2 = 0;
int *piAddressVarTwo = NULL;
double *pdVarTwo = NULL;
int iType2 = 0;
int m_out = 0, n_out = 0;
double *dOut = NULL;
int i;
/* --> result = csum(3,8)
/* check that we have only 2 parameters input */
/* check that we have only 1 parameters output */
CheckInputArgument(pvApiCtx,2,2) ;
CheckOutputArgument(pvApiCtx,1,1) ;
/* get Address of inputs */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
/* check input type */
sciErr = getVarType(pvApiCtx, piAddressVarOne, &iType1);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if ( iType1 != sci_matrix )
{
Scierror(999,"%s: Wrong type for input argument #%d: A integer expected.\n",fname,1);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddressVarTwo, &iType2);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
if ( iType2 != sci_matrix )
{
Scierror(999,"%s: Wrong type for input argument #%d: A double expected.\n",fname,2);
return 0;
}
// /* get string */
// sciErr = getMatrixOfString(pvApiCtx, piAddressVarOne,&m1, &n1, NULL, NULL);
// //sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne,&m1,&n1,&pdVarOne);
// if(sciErr.iErr)
// {
// printError(&sciErr, 0);
// return 0;
// }
//
//
// piLenVarOne = (int*)malloc(sizeof(int) * m1 * n1);
// sciErr = getMatrixOfString(pvApiCtx, piAddressVarOne, &m1, &n1, piLenVarOne, NULL);
// if(sciErr.iErr)
// {
// printError(&sciErr, 0);
// return 0;
// }
//
// fileData = (char**)malloc(sizeof(char*) * m1 * n1);
// for(i = 0 ; i < n1 * m1 ; i++)
// {
// fileData[i] = (char*)malloc(sizeof(char) * (piLenVarOne[i] + 1));//+ 1 for null termination
// }
//
// sciErr = getMatrixOfString(pvApiCtx, piAddressVarOne, &m1, &n1, piLenVarOne, fileData);
// if(sciErr.iErr)
// {
// printError(&sciErr, 0);
// return 0;
// }
/* get double */
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne,&m1,&n1,&pdVarOne);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo,&m2,&n2,&pdVarTwo);
if(sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
/* check size */
if ( (m1 != 1) || (n1 != 1) )
{
Scierror(999,"%s: Wrong size for input argument #%d: One scalar expected.\n",fname,1);
return 0;
}
if ( (m2 !=1) || (n2 !=1) )
{
Scierror(999,"%s: Wrong size for input argument #%d: A scalar expected.\n",fname,2);
return 0;
}
/* call c function csum */
// csum(&pdVarOne[0],&pdVarTwo[0],&dOut);
// if ( edfopen_file_readonly((int)pdVarTwo[0], &edfhdr, EDFLIB_DO_NOT_READ_ANNOTATIONS )<0)
// {
// Scierror(999,"Could not open file %s. filetyp %d\n", fileData[0],edfhdr.filetype);
// return 0;
// }
//
// if (pdVarTwo[0]>=edfhdr.edfsignals){
// Scierror(999,"Only %d signals are available in this file.\n",edfhdr.edfsignals);
// edfclose_file(edfhdr.handle);
// return 0;
//
// }
n_out=1;m_out=1;
if (pdVarTwo[0]<1){
//m_out=edfhdr.signalparam[(int)pdVarTwo[0]].smp_in_file;
Scierror(999,"the edfsignal must be greater then 0.\n");
return 0;
//printf("m_out %d",m_out);
}
// if (m_out>edfhdr.signalparam[(int)pdVarTwo[0]].smp_in_file){
// Scierror(999,"Only %d values are available in this signal.\n",edfhdr.signalparam[(int)pdVarTwo[0]].smp_in_file);
//edfclose_file(edfhdr.handle);
// return 0;
// }
//m_out = edfhdr.signalparam[(int)pdVarTwo[0]].smp_in_file; n_out = 1;
//m_out = pdVarThree[0]; n_out = 1;
dOut = (double*)malloc(sizeof(double) * m_out*n_out);
// CreateVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m_out, &n_out, &dout);
dOut[0]=edftell((int)pdVarOne[0],(int)pdVarTwo[0]-1);
if (dOut[0] < 0){
Scierror(999,"Could not return the current offset.\n");
//edfclose_file(edfhdr.handle);
return 0;
}
// edfclose_file(edfhdr.handle);
/* create result on stack */
// m_out = 1000; n_out = 1;
createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, m_out, n_out, dOut);
free(dOut);
AssignOutputVariable(pvApiCtx,1) = nbInputArgument(pvApiCtx) + 1;
/* This function put on scilab stack, the lhs variable
which are at the position lhs(i) on calling stack */
/* You need to add PutLhsVar here because WITHOUT_ADD_PUTLHSVAR
was defined and equal to %t */
/* without this, you do not need to add PutLhsVar here */
ReturnArguments(pvApiCtx);
return 0;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_find(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
int iMax = -1;
if (in.size() > 2)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "find", 1, 2);
return types::Function::Error;
}
if (in.size() == 2)
{
if (in[1]->isDouble() == false || in[1]->getAs<types::Double>()->isScalar() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Scalar positive integer expected.\n"), "find", 2);
return types::Function::Error;
}
iMax = (int)in[1]->getAs<types::Double>()->get()[0];
if (iMax <= 0 && iMax != -1)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Scalar positive integer expected.\n"), "find", 2);
return types::Function::Error;
}
}
int* piIndex = 0;
int iValues = 0;
if (in[0]->isGenericType() == false)
{
//call overload for other types
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_find";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
types::GenericType* pGT = in[0]->getAs<types::GenericType>();
piIndex = new int[pGT->getSize()];
if (in[0]->isBool())
{
types::Bool* pB = in[0]->getAs<types::Bool>();
int size = pB->getSize();
int* p = pB->get();
iMax = iMax == -1 ? size : std::min(iMax, size);
for (int i = 0 ; i < size && iValues < iMax ; i++)
{
if (p[i])
{
piIndex[iValues] = i;
iValues++;
}
}
}
else if (in[0]->isDouble())
{
types::Double* pD = in[0]->getAs<types::Double>();
int size = pD->getSize();
double* p = pD->get();
iMax = iMax == -1 ? size : std::min(iMax, size);
for (int i = 0; i < size && iValues < iMax; i++)
{
if (p[i])
{
piIndex[iValues] = i;
iValues++;
}
}
}
else if (in[0]->isSparse())
{
types::Sparse* pSP = in[0]->getAs<types::Sparse>();
int iNNZ = (int)pSP->nonZeros();
int iRows = pSP->getRows();
int* pRows = new int[iNNZ * 2];
pSP->outputRowCol(pRows);
int *pCols = pRows + iNNZ;
iMax = iMax == -1 ? iNNZ : std::min(iMax, iNNZ);
for (int i = 0; i < iNNZ && iValues < iMax; i++)
{
piIndex[iValues] = (pCols[i] - 1) * iRows + (pRows[i] - 1);
iValues++;
}
delete[] pRows;
}
else if (in[0]->isSparseBool())
{
types::SparseBool* pSB = in[0]->getAs<types::SparseBool>();
int iNNZ = (int)pSB->nbTrue();
int iRows = pSB->getRows();
int* pRows = new int[iNNZ * 2];
pSB->outputRowCol(pRows);
int* pCols = pRows + iNNZ;
iMax = iMax == -1 ? iNNZ : std::min(iMax, iNNZ);
for (int i = 0; i < iNNZ && iValues < iMax; i++)
{
piIndex[iValues] = (pCols[i] - 1) * iRows + (pRows[i] - 1);
iValues++;
}
delete[] pRows;
}
else
{
delete[] piIndex;
//call overload for other types
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_find";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
if (iValues == 0)
{
for (int i = 0 ; i < _iRetCount ; i++)
{
out.push_back(types::Double::Empty());
}
}
else
{
if (_iRetCount == 1)
{
types::Double* dbl = new types::Double(1, iValues);
double* p = dbl->get();
for (int i = 0; i < iValues; ++i)
{
p[i] = static_cast<double>(piIndex[i]) + 1;
}
delete[] piIndex;
out.push_back(dbl);
return types::Function::OK;
}
int* piRefDims = pGT->getDimsArray();
int iRefDims = pGT->getDims();
int* piDims = new int[_iRetCount];
int iDims = _iRetCount;
if (iDims == iRefDims)
{
for (int i = 0 ; i < iRefDims ; i++)
{
piDims[i] = piRefDims[i];
}
}
else if (iDims > iRefDims)
{
for (int i = 0 ; i < iRefDims ; i++)
{
piDims[i] = piRefDims[i];
}
for (int i = iRefDims ; i < iDims ; i++)
{
piDims[i] = 1;
}
}
else //iDims < iRefDims
{
for (int i = 0 ; i < iDims - 1 ; i++)
{
piDims[i] = piRefDims[i];
}
piDims[iDims - 1] = 1;
for (int i = iDims - 1 ; i < iRefDims ; i++)
{
piDims[iDims - 1] *= piRefDims[i];
}
}
int** piCoord = new int*[iValues];
for (int i = 0 ; i < iValues ; i++)
{
piCoord[i] = new int[_iRetCount];
}
for (int i = 0 ; i < iValues ; i++)
{
getCoordFromIndex(piIndex[i], piCoord[i], piDims, iDims);
}
for (int i = 0 ; i < _iRetCount ; i++)
{
types::Double* pOut = new types::Double(1, iValues);
for (int j = 0 ; j < iValues ; j++)
{
pOut->set(j, piCoord[j][i] + 1);
}
out.push_back(pOut);
}
delete[] piDims;
for (int i = 0 ; i < iValues ; i++)
{
delete[] piCoord[i];
}
delete[] piCoord;
}
delete[] piIndex;
return types::Function::OK;
}
/* set3ddata(pobj,cstk(l2), &l3, &numrow3, &numcol3) */
int set3ddata( char* pobjUID, AssignedList * tlist )
{
char* type;
int m1, n1, m2, n2, m3, n3;
int m3n, n3n;
int isFac3d;
double * pvecx = NULL;
double * pvecy = NULL;
double * pvecz = NULL;
int dimvectx = 0;
int dimvecty = 0;
double* inputColors;
int nbInputColors;
// number of specified colors
int nc = 0;
int izcol;
/* no copy now we just perform tests on the matrices */
pvecx = getCurrentDoubleMatrixFromList( tlist, &m1, &n1 );
pvecy = getCurrentDoubleMatrixFromList( tlist, &m2, &n2 );
pvecz = getCurrentDoubleMatrixFromList( tlist, &m3, &n3 );
if ( m1 * n1 == m3 * n3 && m1 * n1 == m2 * n2 && m1 * n1 != 1 )
{
if ( !(m1 == m2 && m2 == m3 && n1 == n2 && n2 == n3) )
{
Scierror(999, _("%s: Wrong size for arguments #%d, #%d and #%d: Incompatible length.\n"),"Tlist",1,2,3);
return SET_PROPERTY_ERROR;
}
}
else
{
if ( m2 * n2 != n3 )
{
Scierror(999, _("%s: Wrong size for arguments #%d and #%d: Incompatible length.\n"),"Tlist",2,3);
return SET_PROPERTY_ERROR;
}
if ( m1 * n1 != m3 )
{
Scierror(999, _("%s: Wrong size for arguments #%d and #%d: Incompatible length.\n"),"Tlist",1,3);
return SET_PROPERTY_ERROR;
}
if ( m1 * n1 <= 1 || m2 * n2 <= 1 )
{
Scierror(999, _("%s: Wrong size for arguments #%d and #%d: Should be >= %d.\n"),"Tlist",1,2,2);
return SET_PROPERTY_ERROR;
}
}
if ( m1 * n1 == 0 || m2 * n2 == 0 || m3 * n3 == 0 )
{
return sciReturnEmptyMatrix();
}
/* get color size if exists */
if ( getAssignedListNbElement( tlist ) == 4 )
{
getCurrentDoubleMatrixFromList( tlist, &m3n, &n3n ) ;
if ( m3n * n3n == m3 * n3 )
{
/* the color is a matrix, with same size as Z */
izcol = 2;
}
else if (m3n * n3n == n3 && (m3n == 1 || n3n == 1))
{
/* a vector with as many colors as facets */
izcol = 1;
}
else
{
Scierror(999, _("Wrong size for %s element: A %d-by-%d matrix or a vector of size %d expected.\n"), "color", m3, n3, n3);
return SET_PROPERTY_ERROR;
}
}
else
{
m3n = 0;
n3n = 0;
izcol = 0;
}
getGraphicObjectProperty(pobjUID, __GO_TYPE__, jni_string, &type);
if (strcmp(type, __GO_FAC3D__) == 0)
{
isFac3d = 1;
}
else
{
isFac3d = 0;
}
if ( m1 * n1 == m3 * n3 && m1 * n1 == m2 * n2 && m1 * n1 != 1 ) /* NG beg */
{
/* case isfac=1;*/
if (isFac3d == 0)
{
Scierror(999, _("Can not change the %s of graphic object: its type is %s.\n"),"typeof3d","SCI_PLOT3D");
return SET_PROPERTY_ERROR;
}
}
else
{
/* case isfac=0;*/
if (isFac3d == 1)
{
Scierror(999, _("Can not change the %s of graphic object: its type is %s.\n"),"typeof3d","SCI_FAC3D");
return SET_PROPERTY_ERROR;
}
}
/* check the monotony on x and y */
if (isFac3d == 1)
{
/* x is considered as a matrix */
dimvectx = -1;
}
else if ( m1 == 1 ) /* x is a row vector */
{
dimvectx = n1;
}
else if ( n1 == 1 ) /* x is a column vector */
{
dimvectx = m1;
}
else /* x is a matrix */
{
dimvectx = -1;
}
if ( dimvectx > 1 )
{
int monotony = checkMonotony( pvecx, dimvectx );
if ( monotony == 0 )
{
Scierror(999, _("%s: Wrong value: Vector is not monotonous.\n"),"Objplot3d");
return SET_PROPERTY_ERROR;
}
/* To be implemented within the MVC */
#if 0
psurf->flag_x = monotony;
#endif
}
if (isFac3d == 1)
{
/* x is considered as a matrix */
dimvecty = -1;
}
else if(m2 == 1) /* y is a row vector */
{
dimvecty = n2;
}
else if(n2 == 1) /* y is a column vector */
{
dimvecty = m2;
}
else /* y is a matrix */
{
dimvecty = -1;
}
if( dimvecty > 1 )
{
int monotony = checkMonotony( pvecy, dimvecty );
if ( monotony == 0 )
{
Scierror(999, _("%s: Wrong value: Vector is not monotonous.\n"),"Objplot3d");
return SET_PROPERTY_ERROR;
}
/* To be implemented within the MVC */
#if 0
psurf->flag_y = monotony;
#endif
}
/* get the values now */
rewindAssignedList( tlist );
pvecx = getCurrentDoubleMatrixFromList( tlist, &m1, &n1 );
pvecy = getCurrentDoubleMatrixFromList( tlist, &m2, &n2 );
pvecz = getCurrentDoubleMatrixFromList( tlist, &m3, &n3 );
if (isFac3d == 1)
{
int numElementsArray[3];
int result;
numElementsArray[0] = n1;
numElementsArray[1] = m1;
numElementsArray[2] = m3n * n3n;
result = setGraphicObjectProperty(pobjUID, __GO_DATA_MODEL_NUM_ELEMENTS_ARRAY__, numElementsArray, jni_int_vector, 3);
if (result == 0)
{
Scierror(999, _("%s: No more memory.\n"), "set3ddata");
return SET_PROPERTY_ERROR;
}
}
else if (isFac3d == 0)
{
int gridSize[4];
int result;
gridSize[0] = m1;
gridSize[1] = n1;
gridSize[2] = m2;
gridSize[3] = n2;
result = setGraphicObjectProperty(pobjUID, __GO_DATA_MODEL_GRID_SIZE__, gridSize, jni_int_vector, 4);
if (result == 0)
{
Scierror(999, _("%s: No more memory.\n"), "set3ddata");
return SET_PROPERTY_ERROR;
}
}
setGraphicObjectProperty(pobjUID, __GO_DATA_MODEL_X__, pvecx, jni_double_vector, m1*n1);
setGraphicObjectProperty(pobjUID, __GO_DATA_MODEL_Y__, pvecy, jni_double_vector, m2*n2);
setGraphicObjectProperty(pobjUID, __GO_DATA_MODEL_Z__, pvecz, jni_double_vector, m3*n3);
if( getAssignedListNbElement( tlist ) == 4 ) /* F.Leray There is a color matrix */
{
inputColors = getCurrentDoubleMatrixFromList( tlist, &m3n, &n3n );
nbInputColors = m3n * n3n;
}
else
{
inputColors = NULL;
nbInputColors = 0;
}
/*
* Plot 3d case not treated for now
* To be implemented
*/
if (isFac3d == 1)
{
setGraphicObjectProperty(pobjUID, __GO_DATA_MODEL_COLORS__, inputColors, jni_double_vector, nbInputColors);
}
/* Color vector/matrix dimensions: to be checked for MVC implementation */
#if 0
psurf->m3n = m3n; /* If m3n and n3n are 0, then it means that no color matrix/vector was in input*/
psurf->n3n = n3n;
#endif
return SET_PROPERTY_SUCCEED;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_residu(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
int iRows[3] = {0, 0, 0};
int iCols[3] = {0, 0, 0};
int iComplex[3] = {0, 0, 0};
int* piRank[3] = {NULL, NULL, NULL};
double** pdblInR[3] = {NULL, NULL, NULL};
double** pdblInI[3] = {NULL, NULL, NULL};
bool isDeletable[3] = {false, false, false};
types::Double* pDblIn[3] = {NULL, NULL, NULL};
types::Polynom* pPoly[3] = {NULL, NULL, NULL};
types::Double* pDblOut = NULL;
double dblEps = nc_eps_machine();
double dZero = 0;
int iOne = 1;
int iSize = 0;
int iError = 0;
if (in.size() != 3)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "residu", 3);
return types::Function::Error;
}
if (_iRetCount > 1)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "residu", 1);
return types::Function::Error;
}
try
{
/*** get inputs arguments ***/
for (int i = 0; i < 3; i++)
{
if (in[i]->isDouble())
{
pDblIn[i] = in[i]->clone()->getAs<types::Double>();
iRows[i] = pDblIn[i]->getRows();
iCols[i] = pDblIn[i]->getCols();
iSize = pDblIn[i]->getSize();
piRank[i] = new int[iSize];
memset(piRank[i], 0x00, iSize * sizeof(int));
pdblInR[i] = new double*[iSize];
double* pdbl = pDblIn[i]->get();
for (int j = 0; j < iSize; j++)
{
pdblInR[i][j] = pdbl + j;
}
if (pDblIn[i]->isComplex())
{
pdblInI[i] = new double*[iSize];
double* pdbl = pDblIn[i]->get();
for (int j = 0; j < iSize; j++)
{
pdblInI[i][j] = pdbl + j;
}
}
}
else if (in[i]->isPoly())
{
pPoly[i] = in[i]->clone()->getAs<types::Polynom>();
iRows[i] = pPoly[i]->getRows();
iCols[i] = pPoly[i]->getCols();
iSize = pPoly[i]->getSize();
piRank[i] = new int[iSize];
pPoly[i]->getRank(piRank[i]);
pdblInR[i] = new double*[iSize];
if (pPoly[i]->isComplex())
{
pdblInI[i] = new double*[iSize];
for (int j = 0; j < iSize; j++)
{
pdblInR[i][j] = pPoly[i]->get(j)->get();
pdblInI[i][j] = pPoly[i]->get(j)->getImg();
}
}
else
{
for (int j = 0; j < iSize; j++)
{
pdblInR[i][j] = pPoly[i]->get(j)->get();
}
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A Matrix or polynom expected.\n"), "residu", i + 1);
throw 1;
}
}
if (iRows[0] != iRows[1] || iCols[0] != iCols[1] || iRows[0] != iRows[2] || iCols[0] != iCols[2])
{
Scierror(999, _("%s: Wrong size for argument: Incompatible dimensions.\n"), "residu");
throw 1;
}
/*** perform operations ***/
if (pdblInI[0] == NULL && pdblInI[1] == NULL && pdblInI[2] == NULL)
{
// real case
pDblOut = new types::Double(iRows[0], iCols[0]);
double* pdblOut = pDblOut->get();
for (int i = 0; i < iRows[0] * iCols[0]; i++)
{
int iErr = 0;
double v = 0;
int iSize1 = piRank[0][i] + 1;
int iSize2 = piRank[1][i] + 1;
int iSize3 = piRank[2][i] + 1;
C2F(residu)(pdblInR[0][i], &iSize1, pdblInR[1][i], &iSize2,
pdblInR[2][i], &iSize3, &v, &dblEps, &iErr);
if (iErr)
{
Scierror(78, _("%s: An error occured in '%s'.\n"), "residu", "residu");
throw iErr;
}
pdblOut[i] = v;
}
}
else
{
// complex case
pDblOut = new types::Double(iRows[0], iCols[0], true);
double* pdblOutR = pDblOut->get();
double* pdblOutI = pDblOut->getImg();
for (int i = 0; i < 3; i++)
{
if (pdblInI[i] == NULL)
{
pdblInI[i] = new double*[iSize];
for (int j = 0; j < iSize; j++)
{
int iLen = piRank[i][j] + 1;
pdblInI[i][j] = new double[iLen];
memset(pdblInI[i][j], 0x00, iLen * sizeof(double));
}
isDeletable[i] = true;
}
}
for (int i = 0; i < iRows[0] * iCols[0]; i++)
{
int iErr = 0;
double real = 0;
double imag = 0;
C2F(wesidu)(pdblInR[0][i], pdblInI[0][i], (piRank[0]) + i,
pdblInR[1][i], pdblInI[1][i], (piRank[1]) + i,
pdblInR[2][i], pdblInI[2][i], (piRank[2]) + i,
&real, &imag, &dblEps, &iErr);
if (iErr)
{
Scierror(78, _("%s: An error occured in '%s'.\n"), "residu", "wesidu");
throw iErr;
}
pdblOutR[i] = real;
pdblOutI[i] = imag;
}
}
}
catch (int error)
{
iError = error;
}
// free memory
for (int i = 0; i < 3; i++)
{
if (pDblIn[i])
{
delete pDblIn[i];
}
if (pPoly[i])
{
delete pPoly[i];
}
if (piRank[i])
{
delete[] piRank[i];
}
if (pdblInR[i])
{
delete[] pdblInR[i];
}
if (isDeletable[i])
{
for (int j = 0; j < iSize; j++)
{
delete[] pdblInI[i][j];
}
}
if (pdblInI[i])
{
delete[] pdblInI[i];
}
}
/*** retrun output arguments ***/
if (iError)
{
return types::Function::Error;
}
out.push_back(pDblOut);
return types::Function::OK;
}