Beispiel #1
0
int gw_action_binding()
{
    Scierror(999, _("Scilab '%s' module not installed.\n"), "action_binding");
    return 0;
}
Beispiel #2
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;
}
Beispiel #5
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;
}
Beispiel #6
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;
}
Beispiel #7
0
/*--------------------------------------------------------------------------*/
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;
}
Beispiel #8
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;
}
Beispiel #9
0
/*--------------------------------------------------------------------------*/
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;
}
Beispiel #11
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;
    }

}
Beispiel #12
0
/*--------------------------------------------------------------------------*/
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;
}
Beispiel #13
0
/*--------------------------------------------------------------------------*/
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;
}
Beispiel #14
0
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;
}
Beispiel #16
0
// 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);
}
Beispiel #17
0
/*--------------------------------------------------------------------------*/
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;
}
Beispiel #18
0
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;
}
Beispiel #19
0
/*--------------------------------------------------------------------------*/
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;
}
Beispiel #21
0
int sci_gpuMatrix(char *fname)
{
    CheckRhs(2, 3);
    CheckLhs(1, 1);

    SciErr sciErr;

    int*    piAddr_A    = NULL;
    int     inputType_A = 0;
    int*    piAddr_R    = NULL;
    int     inputType_R = 0;
    int*    piAddr_C    = NULL;
    int     inputType_C = 0;

    int     rows        = 0;
    int     cols        = 0;
    int     newRows     = 0;
    int     newCols     = 0;

    void*   pvPtr       = NULL;
    GpuPointer* gpuPtrA = NULL;

    try
    {
        if (!isGpuInit())
        {
            throw "gpu is not initialised. Please launch gpuInit() before use this function.";
        }

        //--- Get input matrix ---
        sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr_A);
        if (sciErr.iErr)
        {
            throw sciErr;
        }

        // Get size and data
        sciErr = getVarType(pvApiCtx, piAddr_A, &inputType_A);
        if (sciErr.iErr)
        {
            throw sciErr;
        }

        //--- Get new Rows size or vector of sizes---
        sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr_R);
        if (sciErr.iErr)
        {
            throw sciErr;
        }

        // Get size and data
        sciErr = getVarType(pvApiCtx, piAddr_R, &inputType_R);
        if (sciErr.iErr)
        {
            throw sciErr;
        }

        if (inputType_R != sci_matrix)
        {
            throw "gpuMatrix : Bad type for input argument #2: A real scalar or row vector expected.";
        }

        if (isVarComplex(pvApiCtx, piAddr_A))
        {
            throw "gpuMatrix : Bad type for input argument #2: A real scalar or row vector expected.";
        }
        else
        {
            double* dRows = NULL;
            sciErr = getMatrixOfDouble(pvApiCtx, piAddr_R, &rows, &cols, &dRows);
            if (sciErr.iErr)
            {
                throw sciErr;
            }
            if (nbInputArgument(pvApiCtx) == 2)
            {
                if (rows != 1 || cols != 2)
                {
                    throw "gpuMatrix : Bad size for input argument #2: A row vector of size two expected.";
                }

                newRows = (int)dRows[0];
                newCols = (int)dRows[1];

                if (newCols < -1 || newCols == 0)
                {
                    throw "gpuMatrix : Wrong value for input argument #3: -1 or positive value expected.";
                }
            }
            else
            {
                newRows = (int)(*dRows);
            }

            if (newRows < -1 || newRows == 0)
            {
                throw "gpuMatrix : Wrong value for input argument #2: -1 or positive value expected.";
            }
        }

        if (nbInputArgument(pvApiCtx) == 3)
        {
            //--- Get new Cols size---
            sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr_C);
            if (sciErr.iErr)
            {
                throw sciErr;
            }

            // Get size and data
            sciErr = getVarType(pvApiCtx, piAddr_C, &inputType_C);
            if (sciErr.iErr)
            {
                throw sciErr;
            }

            if (inputType_C != sci_matrix)
            {
                throw "gpuMatrix : Bad type for input argument #3: A real scalar expected.";
            }

            if (isVarComplex(pvApiCtx, piAddr_A))
            {
                throw "gpuMatrix : Bad type for input argument #3: A real scalar expected.";
            }
            else
            {
                double* dCols = NULL;
                sciErr = getMatrixOfDouble(pvApiCtx, piAddr_C, &rows, &cols, &dCols);
                if (sciErr.iErr)
                {
                    throw sciErr;
                }

                newCols = (int)(*dCols);

                if (newCols < -1 || newCols == 0)
                {
                    throw "gpuMatrix : Wrong value for input argument #3: -1 or positive value expected.";
                }
            }
        }

        if (inputType_A == sci_pointer)
        {
            sciErr = getPointer(pvApiCtx, piAddr_A, (void**)&pvPtr);
            if (sciErr.iErr)
            {
                throw sciErr;
            }

            gpuPtrA = (GpuPointer*)pvPtr;
            if (!PointerManager::getInstance()->findGpuPointerInManager(gpuPtrA))
            {
                throw "gpuMatrix : Bad type for input argument #1: Variables created with GPU functions expected.";
            }

            if (useCuda() && gpuPtrA->getGpuType() != GpuPointer::CudaType)
            {
                throw "gpuMatrix : Bad type for input argument #1: A Cuda pointer expected.";
            }

            if (useCuda() == false && gpuPtrA->getGpuType() != GpuPointer::OpenCLType)
            {
                throw "gpuMatrix : Bad type for input argument #1: A OpenCL pointer expected.";
            }

            rows = gpuPtrA->getRows();
            cols = gpuPtrA->getCols();
        }
        else if (inputType_A == sci_matrix)
        {
            double* h = NULL;
            if (isVarComplex(pvApiCtx, piAddr_A))
            {
                double* hi = NULL;
                sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddr_A, &rows, &cols, &h, &hi);
#ifdef WITH_CUDA
                if (useCuda())
                {
                    gpuPtrA = new PointerCuda(h, hi, rows, cols);
                }
#endif
#ifdef WITH_OPENCL
                if (!useCuda())
                {
                    Scierror(999, "gpuMatrix: not implemented with OpenCL.\n");
                }
#endif
            }
            else
            {
                sciErr = getMatrixOfDouble(pvApiCtx, piAddr_A, &rows, &cols, &h);
#ifdef WITH_CUDA
                if (useCuda())
                {
                    gpuPtrA = new PointerCuda(h, rows, cols);
                }
#endif
#ifdef WITH_OPENCL
                if (!useCuda())
                {
                    Scierror(999, "gpuMatrix: not implemented with OpenCL.\n");
                }
#endif
            }

            if (sciErr.iErr)
            {
                throw sciErr;
            }
        }
        else
        {
            throw "gpuMatrix : Bad type for input argument #1: A GPU or CPU matrix expected.";
        }

        if (newRows == -1 && newCols != -1)
        {
            newRows = rows * cols / newCols;
        }
        else if (newRows != -1 && newCols == -1)
        {
            newCols = rows * cols / newRows;
        }

        if (rows * cols != newRows * newCols)
        {
            throw "gpuMatrix : Wrong value for input arguments #2 and 3: Correct size expected.";
        }

#ifdef WITH_OPENCL
        if (!useCuda())
        {
            Scierror(999, "gpuMatrix: not implemented with OpenCL.\n");
        }
#endif

        GpuPointer* gpuOut = gpuPtrA->clone();
        gpuOut->setRows(newRows);
        gpuOut->setCols(newCols);

        // Put the result in scilab
        PointerManager::getInstance()->addGpuPointerInManager(gpuOut);
        sciErr = createPointer(pvApiCtx, Rhs + 1, (void*)gpuOut);
        LhsVar(1) = Rhs + 1;

        if (inputType_A == 1 && gpuPtrA != NULL)
        {
            delete gpuPtrA;
        }

        PutLhsVar();
        return 0;
    }
    catch (const char* str)
    {
        Scierror(999, "%s\n", str);
    }
    catch (SciErr E)
    {
        printError(&E, 0);
    }

    if (inputType_A == 1 && gpuPtrA != NULL)
    {
        delete gpuPtrA;
    }

    return EXIT_FAILURE;
}
Beispiel #22
0
/*--------------------------------------------------------------------------*/
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;
}
Beispiel #23
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;
}
Beispiel #24
0
/*--------------------------------------------------------------------------*/
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;
}
Beispiel #26
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;
}
Beispiel #27
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;
}
Beispiel #28
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;
}