bool isNamedEmptyMatrix(const wchar_t* _pstName)
{
bool bEmpty = false;
if (_pstName)
{
char *varname = wide_string_to_UTF8(_pstName);
if (varname)
{
bEmpty = dynlib_isNamedEmptyMatrix(pvApiCtx, varname) == 1 ? true : false;
delete varname;
varname = NULL;
}
}
return bEmpty;
}
bool isNamedVarExist(const wchar_t* _pstName)
{
int iExist = 0;
if (_pstName)
{
char *varname = wide_string_to_UTF8(_pstName);
if (varname)
{
iExist = dynlib_isNamedVarExist(pvApiCtx, varname);
delete [] varname;
varname = NULL;
}
}
return (iExist == 1 ? true : false);
}
bool getNamedMatrixOfDouble(const wchar_t* _pstName, int* _piRows, int* _piCols, double* _pdblReal)
{
if (_pstName)
{
char *varname = wide_string_to_UTF8(_pstName);
if (varname)
{
SciErr sciErr = dynlib_readNamedMatrixOfDouble(pvApiCtx, varname, _piRows, _piCols, _pdblReal);
delete [] varname;
varname = NULL;
return (sciErr.iErr == 0 ? true : false);
}
}
return false;
}
/*----------------------------------------------------------------------------*/
char* scistrrev(char* str)
{
char *revstr = NULL;
if (str)
{
wchar_t *wcstr = to_wide_string(str);
#ifdef _MSC_VER
wchar_t *wcrevstr = _wcsrev(wcstr);
revstr = wide_string_to_UTF8(wcrevstr);
#else
int i = 0;
int t = 0;
int j = 0, k = 0;
if (wcstr)
{
i = (int)wcslen(wcstr);
}
t = !(i % 2) ? 1 : 0; // check the length of the string .
/* copy character by character to reverse string */
k = 0;
for (j = i - 1; j > (i / 2 - t) ; j-- )
{
/* j starts from end of string */
/* k starts from beginning of string */
wchar_t ch = wcstr[j]; /* ch temp. character */
wcstr[j] = wcstr[k]; /* end and beginning characters are exchanged */
wcstr[k++] = ch;
}
revstr = wide_string_to_UTF8(wcstr);
#endif
FREE(wcstr);
}
return revstr;
}
bool getNamedScalarDouble(const wchar_t* _pstName, double* _pdblReal)
{
int iErr = -1;
if (_pstName)
{
char *varname = wide_string_to_UTF8(_pstName);
if (varname)
{
iErr = dynlib_getNamedScalarDouble(pvApiCtx, varname, _pdblReal);
delete [] varname;
varname = NULL;
}
}
return (iErr == 0 ? true : false);
}
bool createNamedScalarBoolean(const wchar_t* _pstName, bool _bool)
{
int iErr = -1;
if (_pstName)
{
char *varname = wide_string_to_UTF8(_pstName);
if (varname)
{
iErr = dynlib_createNamedScalarBoolean(pvApiCtx, varname, (_bool == true) ? TRUE : FALSE);
delete [] varname;
varname = NULL;
}
}
return (iErr == 0 ? true : false);
}
/*--------------------------------------------------------------------------*/
wchar_t *get_full_pathW(wchar_t * _wcFullPath, const wchar_t * _wcPath, size_t _SizeInBytes)
{
wchar_t *wcResult = NULL;
#if defined(_MSC_VER)
if (_wcPath)
{
wcResult = (wchar_t *) MALLOC(sizeof(wchar_t) * _SizeInBytes);
if (wcResult)
{
_wfullpath(wcResult, _wcPath, _SizeInBytes);
wcscpy(_wcFullPath, wcResult);
}
}
#else
if (_wcPath)
{
char *_Path = wide_string_to_UTF8(_wcPath);
if (_Path)
{
char *_FullPath = (char *)MALLOC(sizeof(char) * (_SizeInBytes));
if (_FullPath)
{
char *rp = NULL;
rp = realpath(_Path, _FullPath);
if (!rp)
{
strcpy(_FullPath, _Path);
normalizePath(_FullPath);
}
wcResult = to_wide_string(_FullPath);
if (wcResult)
{
wcscpy(_wcFullPath, wcResult);
}
FREE(_FullPath);
_FullPath = NULL;
}
FREE(_Path);
_Path = NULL;
}
}
#endif
return wcResult;
}
static bool scirun(wchar_t *wcommand)
{
bool bOK = false;
if (wcommand)
{
char *command = wide_string_to_UTF8(wcommand);
if (command)
{
dynlib_scirun(command, strlen(command));
delete command;
command = NULL;
bOK = true;
}
}
return bOK;
}
int File::getCountLines()
{
char* pstFileName = wide_string_to_UTF8(m_stFilename.c_str());
std::ifstream in(pstFileName);
std::string stLine;
int iLines = 0;
while (std::getline(in, stLine))
{
iLines++;
}
in.close();
FREE(pstFileName);
return iLines;
}
bool getNamedScalarBoolean(const wchar_t* _pstName, bool* _pbool)
{
int iErr = -1;
if (_pstName)
{
char *varname = wide_string_to_UTF8(_pstName);
if (varname)
{
int bVal = 0;
iErr = dynlib_getNamedScalarBoolean(pvApiCtx, varname, &bVal);
*_pbool = (bVal == TRUE) ? true : false;
delete [] varname;
varname = NULL;
}
}
return (iErr == 0 ? true : false);
}
/**
* Export the variable LC_XXXX to the system
*
* @param locale the locale (ex : fr_FR or en_US)
*/
BOOL exportLocaleToSystem(const wchar_t *locale)
{
if (locale == NULL)
{
#ifdef _MSC_VER
fprintf(stderr, "Localization: Have not been able to find a suitable locale. Remains to default %s.\n", "LC_CTYPE");
#else
fprintf(stderr, "Localization: Have not been able to find a suitable locale. Remains to default %ls.\n", EXPORTENVLOCALESTR);
#endif
return FALSE;
}
/* It will put in the env something like LC_MESSAGES=fr_FR */
if ( !setenvcW(EXPORTENVLOCALESTR, locale))
{
#ifdef _MSC_VER
fprintf(stderr, "Localization: Failed to declare the system variable %s.\n", "LC_CTYPE");
#else
fprintf(stderr, "Localization: Failed to declare the system variable %d.\n", EXPORTENVLOCALE);
#endif
return FALSE;
}
#ifdef _MSC_VER
#ifdef USE_SAFE_GETTEXT_DLL
{
/* gettext is buggy on Windows */
/* We need to set a external environment variable to scilab env. */
char* pstr = NULL;
wchar_t env[MAX_PATH];
os_swprintf(env, MAX_PATH, L"%ls=%ls", EXPORTENVLOCALESTR, locale);
pstr = wide_string_to_UTF8(env);
gettext_putenv(pstr);
FREE(pstr);
}
#endif
#else
/* Export LC_NUMERIC to the system to make sure that the rest of system
is using the english notation (Java, Tcl ...) */
setenvc("LC_NUMERIC", LCNUMERICVALUE);
#endif
return TRUE;
}
/*--------------------------------------------------------------------------*/
char *pathconvert(char* path, BOOL flagtrail, BOOL flagexpand, PathConvertType PType)
{
char *convertedPath = NULL;
if (path)
{
wchar_t *wcpath = to_wide_string(path);
if (wcpath)
{
wchar_t *wcconvertedPath = pathconvertW(wcpath, flagtrail, flagexpand, PType);
if (wcconvertedPath)
{
convertedPath = wide_string_to_UTF8(wcconvertedPath);
FREE(wcconvertedPath);
wcconvertedPath = NULL;
}
}
}
return convertedPath;
}
static char *getLineAfterCaret(char *wk_buf, unsigned int *cursor, unsigned int *cursor_max)
{
if (wk_buf)
{
if (*cursor != *cursor_max)
{
int len = *cursor_max - *cursor;
wchar_t * wtmp = to_wide_string(wk_buf);
wchar_t aftercaret[WK_BUF_SIZE];
wcscpy(aftercaret, &wtmp[*cursor]);
aftercaret[len + 1] = '\0';
FREE(wtmp);
return wide_string_to_UTF8(aftercaret);
}
}
return strdup("");
}
/*--------------------------------------------------------------------------*/
char *expandPathVariable(char* str)
{
char *expanded = NULL;
wchar_t *wstr = to_wide_string(str);
if (wstr)
{
wchar_t *wcexpanded = expandPathVariableW(wstr);
if (wcexpanded)
{
expanded = wide_string_to_UTF8(wcexpanded);
FREE(wcexpanded);
wcexpanded = NULL;
}
FREE(wstr);
wstr = NULL;
}
return expanded;
}
/*--------------------------------------------------------------------------*/
BOOL removedirW(wchar_t *pathW)
{
if (isdirW(pathW))
{
#ifdef _MSC_VER
DeleteDirectory(pathW);
#else
char *path = wide_string_to_UTF8(pathW);
if (path)
{
DeleteDirectory(path);
FREE(path);
path = NULL;
}
#endif
if (!isdirW(pathW)) return TRUE;
}
return FALSE;
}
DynamicFunction::DynamicFunction(const std::wstring& _wstName, const std::wstring& _wstEntryPointName, const std::wstring& _wstLibName, FunctionType _iType, LOAD_DEPS _pLoadDeps, const std::wstring& _wstModule, bool _bCloseLibAfterCall)
{
m_wstName = _wstName;
char* s = wide_string_to_UTF8(m_wstName.data());
m_stName = s;
FREE(s);
m_wstLibName = _wstLibName;
m_wstModule = _wstModule;
m_wstEntryPoint = _wstEntryPointName;
m_pLoadDeps = _pLoadDeps;
m_wstLoadDepsName = L"";
m_bCloseLibAfterCall = _bCloseLibAfterCall;
m_iType = _iType;
m_pFunc = NULL;
m_pOptFunc = NULL;
m_pOldFunc = NULL;
m_pMexFunc = NULL;
m_pFunction = NULL;
m_pCFunc = NULL;
}
types::Function::ReturnValue sci_hdf5_file_version(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
int rhs = static_cast<int>(in.size());
if (rhs < 1)
{
Scierror(999, _("%s: Wrong number of input argument(s): at least %d expected.\n"), fname.data(), 1);
return types::Function::Error;
}
if (in[0]->getId() != types::InternalType::IdScalarString)
{
Scierror(999, _("%s: Wrong size for input argument #%d: string expected.\n"), fname.data(), 1);
return types::Function::Error;
}
wchar_t* wfilename = expandPathVariableW(in[0]->getAs<types::String>()->get()[0]);
char* cfilename = wide_string_to_UTF8(wfilename);
std::string filename = cfilename;
FREE(wfilename);
FREE(cfilename);
int iFile = openHDF5File(filename.data(), 0);
if (iFile < 0)
{
Scierror(999, _("%s: Unable to open file: %s\n"), fname.data(), filename.data());
return types::Function::Error;
}
std::wstring wstFuncName;
//manage version information
int version = getSODFormatAttribute(iFile);
closeHDF5File(iFile);
if (version == -1)
{
version = 1;
}
out.push_back(new types::Double(static_cast<double>(version)));
return types::Function::OK;
}
/* Autocompletion in NW/NWNI */
void autoCompletionInConsoleMode(wchar_t ** commandLine, unsigned int *cursorLocation)
{
char *multiByteString = NULL;
wchar_t *wideString = NULL;
int sizeToAlloc = 0;
unsigned int nbrCharInString;
multiByteString = wide_string_to_UTF8(*commandLine);
nbrCharInString = wcslen(*commandLine);
doCompletion(&multiByteString, cursorLocation, &nbrCharInString);
wideString = to_wide_string(multiByteString);
/* Copy the new string in a buffer wich size is a multiple of 1024 */
sizeToAlloc = 1024 * (wcslen(wideString) / 1024 + 1);
FREE(*commandLine);
*commandLine = MALLOC(sizeof(**commandLine) * sizeToAlloc);
wcscpy(*commandLine, wideString);
FREE(wideString);
FREE(multiByteString);
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_notify(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
types::String* pString = NULL;
wchar_t* wcsInput = NULL;
if (in.size() != 1)
{
Scierror(999, _("%s: Wrong number of input arguments: %d expected.\n"), "notify" , 1);
return types::Function::Error;
}
if (in[0]->isString() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), "notify", 1);
return types::Function::Error;
}
pString = in[0]->getAs<types::String>();
if (pString->isScalar() == FALSE)
{
Scierror(999, _("%s: Wrong size for input argument #%d: string expected.\n"), "notify" , 1);
return types::Function::Error;
}
wcsInput = pString->get(0);
char* strInput = wide_string_to_UTF8(wcsInput);
try
{
org_scilab_modules_action_binding_utils::Signal::notify(getScilabJavaVM(), strInput);
}
catch (const GiwsException::JniException & e)
{
Scierror(999, _("%s: A Java exception arisen:\n%s"), "notify", e.whatStr().c_str());
FREE(strInput);
return types::Function::Error;
}
FREE(strInput);
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
char *FindFileAssociation (char *ptrFindStr,char *Extra)
{
char *ptrResult = NULL ;
if ( ptrFindStr )
{
wchar_t *wcptrFindStr = to_wide_string(ptrFindStr);
wchar_t *wcExtra = to_wide_string(Extra);
wchar_t szDefault[PATH_MAX + FILENAME_MAX];
DWORD ccDefault = PATH_MAX + FILENAME_MAX;
if (wcptrFindStr)
{
HRESULT rc = AssocQueryStringW (0, ASSOCSTR_EXECUTABLE,wcptrFindStr, wcExtra, szDefault, &ccDefault);
if (ccDefault)
{
if (rc == S_OK) ptrResult = wide_string_to_UTF8(szDefault);
}
}
}
return ptrResult;
}
/*--------------------------------------------------------------------------*/
char *searchEnv(const char *name, const char *env_var)
{
char *buffer = NULL;
char fullpath[PATH_MAX];
strcpy(fullpath, "");
#if _MSC_VER
{
wchar_t *wname = NULL;
wchar_t *wenv_var = NULL;
wchar_t wfullpath[PATH_MAX];
wname = to_wide_string((char*)name);
wenv_var = to_wide_string((char*)env_var);
wcscpy(wfullpath, L"");
_wsearchenv(wname, wenv_var, wfullpath);
if (wcslen(wfullpath) > 0)
{
buffer = wide_string_to_UTF8(wfullpath);
}
FREE(wname);
FREE(wenv_var);
}
#else
searchenv_others(name, env_var, fullpath);
if (strlen(fullpath) > 0)
{
buffer = strdup(fullpath);
}
#endif
return buffer;
}
/*--------------------------------------------------------------------------*/
BOOL isdirW(const wchar_t * wcpath)
{
BOOL bOK = FALSE;
#ifndef _MSC_VER
struct stat buf;
char *path = wide_string_to_UTF8(wcpath);
if (path == NULL)
{
return FALSE;
}
bOK = isdir(path);
FREE(path);
#else
if (isDriveW(wcpath))
{
return TRUE;
}
else
{
DWORD attr = 0;
wchar_t *tmpPath = os_wcsdup(wcpath);
if ( (tmpPath[wcslen(tmpPath) - 1] == L'\\') || (tmpPath[wcslen(tmpPath) - 1] == L'/') )
{
tmpPath[wcslen(tmpPath) - 1] = L'\0';
}
attr = GetFileAttributesW(tmpPath);
FREE(tmpPath);
if (attr == INVALID_FILE_ATTRIBUTES)
{
return FALSE;
}
return ((attr & FILE_ATTRIBUTE_DIRECTORY) != 0) ? TRUE : FALSE;
}
#endif
return bOK;
}
/*--------------------------------------------------------------------------*/
wchar_t *createtempfilenameW(const wchar_t *wcprefix, BOOL bShortFormat)
{
wchar_t *wcReturnedTempFilename = NULL;
#ifdef _MSC_VER
wchar_t *wcTmpDir = getTMPDIRW();
if (wcTmpDir)
{
unsigned int uRetVal = 0;
wchar_t wcTempFileName[MAX_PATH];
uRetVal = GetTempFileNameW(wcTmpDir, wcprefix, 0, wcTempFileName);
if (uRetVal != 0)
{
size_t len = wcslen(wcTempFileName) + 1;
wchar_t* shortTempFilename = (wchar_t *)MALLOC(len * sizeof(wchar_t));
if (shortTempFilename)
{
if (bShortFormat)
{
GetShortPathNameW(wcTempFileName, shortTempFilename, (DWORD)len);
}
wcReturnedTempFilename = shortTempFilename;
}
}
}
#else
char *prefix = wide_string_to_UTF8(wcprefix);
char *result = createtempfilename(prefix, bShortFormat);
wcReturnedTempFilename = to_wide_string(result);
if (result) {FREE(result); result = NULL;}
if (prefix) {FREE(prefix); prefix = NULL;}
if (result) {FREE(result); result = NULL;}
#endif
return wcReturnedTempFilename;
}
bool PCREMatcher::match(const wchar_t * str, const unsigned int len, const bool full) const
{
if (!pattern.empty())
{
int resVect[3];
char * _str = wide_string_to_UTF8(str);
int result = pcre_exec(re, nullptr, _str, len, 0, 0, resVect, sizeof(resVect) / sizeof(int));
FREE(_str);
if (full)
{
if (result == 1 && resVect[0] == 0 && resVect[1] == len)
{
return true;
}
}
else
{
return result == 1;
}
return false;
}
return true;
}
/*--------------------------------------------------------------------------*/
char *createtempfilename(const char *prefix, BOOL bShortFormat)
{
char *tempfilename = NULL;
#ifdef _MSC_VER
wchar_t *wcprefix = to_wide_string(prefix);
wchar_t *wcresult = createtempfilenameW(wcprefix, bShortFormat);
tempfilename = wide_string_to_UTF8(wcresult);
if (wcresult) {FREE(wcresult); wcresult = NULL;}
if (wcresult) {FREE(wcresult); wcresult = NULL;}
#else
char *TmpDir = getTMPDIR();
if (TmpDir)
{
char TempFileName[PATH_MAX];
sprintf(TempFileName, "%s/%sXXXXXX",TmpDir, prefix);
int fd = mkstemp(TempFileName);
if (fd != -1) close(fd);
tempfilename = strdup(TempFileName);
}
#endif
return tempfilename;
}
types::Function::ReturnValue sci_interp3d(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
// input
types::Double* pDblXYZ[3] = {NULL, NULL, NULL};
types::TList* pTList = NULL;
types::Double* pDblX = NULL;
types::Double* pDblY = NULL;
types::Double* pDblZ = NULL;
types::Double* pDblOrder = NULL;
types::Double* pDblCoef = NULL;
types::Double* pDblXyzminmax = NULL;
// output
types::Double* pDblFp = NULL;
types::Double* pDblFpdx = NULL;
types::Double* pDblFpdy = NULL;
types::Double* pDblFpdz = NULL;
int iType = 0;
int order[3];
int sizeOfXp;
// *** check the minimal number of input args. ***
if ((in.size() < 4) || (5 < in.size()))
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "interp3d", 4);
return types::Function::Error;
}
// *** check number of output args according the methode. ***
if (_iRetCount > 4)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d to %d expected.\n"), "interp3d", 1, 4);
return types::Function::Error;
}
// *** check type of input args and get it. ***
// xp yp zp
for (int i = 0; i < 3; i++)
{
if (in[i]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : A matrix expected.\n"), "interp3d", i + 1);
return types::Function::Error;
}
pDblXYZ[i] = in[i]->getAs<types::Double>();
if (pDblXYZ[0]->getRows() != pDblXYZ[i]->getRows() || pDblXYZ[0]->getCols() != pDblXYZ[i]->getCols())
{
Scierror(999, _("%s: Wrong size for input argument #%d : Same size as argument %d expected.\n"), "interp3d", i + 1, 1);
return types::Function::Error;
}
if (pDblXYZ[i]->isComplex())
{
Scierror(999, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), "interp3d", i + 1);
return types::Function::Error;
}
}
sizeOfXp = pDblXYZ[0]->getSize();
if (in[3]->isTList() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : A tlist of type %s expected.\n"), "interp3d", 4, "tensbs3d");
}
pTList = in[3]->getAs<types::TList>();
if (pTList->getTypeStr() != L"tensbs3d")
{
Scierror(999, _("%s: Wrong type for input argument #%d: A %s tlist expected.\n"), "interp3d", 4, "tensbs3d");
return types::Function::Error;
}
pDblX = pTList->getField(L"tx")->getAs<types::Double>();
pDblY = pTList->getField(L"ty")->getAs<types::Double>();
pDblZ = pTList->getField(L"tz")->getAs<types::Double>();
pDblOrder = pTList->getField(L"order")->getAs<types::Double>();
pDblCoef = pTList->getField(L"bcoef")->getAs<types::Double>();
pDblXyzminmax = pTList->getField(L"xyzminmax")->getAs<types::Double>();
if (in.size() == 5)
{
if (in[4]->isString() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : string expected.\n"), "interp3d", 5);
return types::Function::Error;
}
wchar_t* wcsType = in[4]->getAs<types::String>()->get(0);
if (wcscmp(wcsType, L"C0") == 0)
{
iType = 8;
}
else if (wcscmp(wcsType, L"by_zero") == 0)
{
iType = 7;
}
else if (wcscmp(wcsType, L"periodic") == 0)
{
iType = 3;
}
else if (wcscmp(wcsType, L"by_nan") == 0)
{
iType = 10;
}
else // undefined
{
char* pstType = wide_string_to_UTF8(wcsType);
Scierror(999, _("%s: Wrong values for input argument #%d : '%s' is an unknown '%s' type.\n"), "interp3d", 5, pstType, "outmode");
FREE(pstType);
return types::Function::Error;
}
}
else
{
//"C0"
iType = 8;
}
// *** Perform operation. ***
pDblFp = new types::Double(pDblXYZ[0]->getRows(), pDblXYZ[0]->getCols());
order[0] = static_cast<int>(pDblOrder->get(0));
order[1] = static_cast<int>(pDblOrder->get(1));
order[2] = static_cast<int>(pDblOrder->get(2));
int sizeOfX = pDblX->getRows() - order[0];
int sizeOfY = pDblY->getRows() - order[1];
int sizeOfZ = pDblZ->getRows() - order[2];
double* minmax = pDblXyzminmax->get();
int workSize = order[1] * order[2] + 3 * std::max(order[0], std::max(order[1], order[2])) + order[2];
double* work = new double[workSize];
if (_iRetCount == 1)
{
C2F(driverdb3val)(pDblXYZ[0]->get(), pDblXYZ[1]->get(), pDblXYZ[2]->get(), pDblFp->get(), &sizeOfXp,
pDblX->get(), pDblY->get(), pDblZ->get(), &sizeOfX, &sizeOfY, &sizeOfZ,
&order[0], &order[1], &order[2], pDblCoef->get(), work,
&minmax[0], &minmax[1], &minmax[2], &minmax[3], &minmax[4], &minmax[5], &iType);
}
else // _iRetCount == 4
{
pDblFpdx = new types::Double(pDblXYZ[0]->getRows(), pDblXYZ[0]->getCols());
pDblFpdy = new types::Double(pDblXYZ[0]->getRows(), pDblXYZ[0]->getCols());
pDblFpdz = new types::Double(pDblXYZ[0]->getRows(), pDblXYZ[0]->getCols());
C2F(driverdb3valwithgrad)(pDblXYZ[0]->get(), pDblXYZ[1]->get(), pDblXYZ[2]->get(),
pDblFp->get(), pDblFpdx->get(), pDblFpdy->get(), pDblFpdz->get(),
&sizeOfXp, pDblX->get(), pDblY->get(), pDblZ->get(),
&sizeOfX, &sizeOfY, &sizeOfZ, &order[0], &order[1], &order[2], pDblCoef->get(), work,
&minmax[0], &minmax[1], &minmax[2], &minmax[3], &minmax[4], &minmax[5], &iType);
}
delete[] work;
// *** Return result in Scilab. ***
switch (_iRetCount)
{
case 4 :
out.insert(out.begin(), pDblFpdz);
case 3 :
out.insert(out.begin(), pDblFpdy);
case 2 :
out.insert(out.begin(), pDblFpdx);
default :
break;
}
out.insert(out.begin(), pDblFp);
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_intg(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
double pdA = 0;
double pdB = 0;
double pdEpsR = 1.0e-8;
double pdEpsA = 1.0e-13;
double result = 0;
double abserr = 0;
int iOne = 1;
// error message catched
std::wostringstream os;
bool bCatch = false;
// *** check the minimal number of input args. ***
if (in.size() < 3 || in.size() > 5)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "intg", 3);
return types::Function::Error;
}
// *** check number of output args ***
if (_iRetCount > 3)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "intg", 3);
return types::Function::Error;
}
// *** check type of input args and get it. ***
// A
if (in[0]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "intg", 1);
return types::Function::Error;
}
types::Double* pDblA = in[0]->getAs<types::Double>();
if (pDblA->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "intg", 1);
return types::Function::Error;
}
pdA = pDblA->get(0);
if (ISNAN(pdA) || C2F(vfinite)(&iOne , &pdA) == false)
{
Scierror(264, _("%s: Wrong type for input argument #%d: Must not contain NaN or Inf.\n"), "intg", 1);
return types::Function::Error;
}
// B
if (in[1]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "intg", 2);
return types::Function::Error;
}
types::Double* pDblB = in[1]->getAs<types::Double>();
if (pDblB->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "intg", 2);
return types::Function::Error;
}
pdB = pDblB->get(0);
if (ISNAN(pdB) || C2F(vfinite)(&iOne , &pdB) == false)
{
Scierror(264, _("%s: Wrong type for input argument #%d: Must not contain NaN or Inf.\n"), "intg", 1);
return types::Function::Error;
}
// function
DifferentialEquationFunctions deFunctionsManager(L"intg");
DifferentialEquation::addDifferentialEquationFunctions(&deFunctionsManager);
if (in[2]->isCallable())
{
types::Callable* pCall = in[2]->getAs<types::Callable>();
deFunctionsManager.setFFunction(pCall);
// check function
double t = 1;
double ret = intg_f(&t);
/* if (ret == 0)
{
Scierror(50, _("%s: Argument #%d: Variable returned by scilab argument function is incorrect.\n"), "intg", 3);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}*/
}
else if (in[2]->isString())
{
bool bOK = false;
types::String* pStr = in[2]->getAs<types::String>();
bOK = deFunctionsManager.setFFunction(pStr);
if (bOK == false)
{
char* pst = wide_string_to_UTF8(pStr->get(0));
Scierror(50, _("%s: Subroutine not found: %s\n"), "intg", pst);
FREE(pst);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
}
else if (in[2]->isList())
{
types::List* pList = in[2]->getAs<types::List>();
if (pList->getSize() == 0)
{
Scierror(50, _("%s: Argument #%d: Subroutine not found in list: %s\n"), "intg", 3, "(string empty)");
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
if (pList->get(0)->isCallable())
{
deFunctionsManager.setFFunction(pList->get(0)->getAs<types::Callable>());
for (int iter = 1; iter < pList->getSize(); iter++)
{
deFunctionsManager.setFArgs(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 Scilab function.\n"), "intg", 3);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A function expected.\n"), "intg", 3);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
if (in.size() > 3)
{
if (in[3]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "intg", 4);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
types::Double* pDblEpsA = in[3]->getAs<types::Double>();
if (pDblEpsA->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "intg", 4);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
pdEpsA = pDblEpsA->get(0);
}
if (in.size() == 5)
{
if (in[4]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "intg", 5);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
types::Double* pDblEpsR = in[4]->getAs<types::Double>();
if (pDblEpsR->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "intg", 5);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
pdEpsR = pDblEpsR->get(0);
}
// *** Create working table. ***
int limit = 750;
int neval = 0;
int last = 0;
int lenw = 4 * limit;
double* dwork = (double*)MALLOC(lenw * sizeof(double));
int* iwork = (int*)MALLOC(limit * sizeof(int));
double epsabs = fabs(pdEpsA);
double epsrel = fabs(pdEpsR);
// *** Perform operation. ***
int ier = 0;
try
{
C2F(dqags)(intg_f, &pdA, &pdB, &epsabs, &epsrel,
&result, &abserr, &neval, &ier,
&limit, &lenw, &last, iwork, dwork);
}
catch (ast::InternalError &ie)
{
os << ie.GetErrorMessage();
bCatch = true;
}
FREE(dwork);
FREE(iwork);
DifferentialEquation::removeDifferentialEquationFunctions();
if (bCatch)
{
wchar_t szError[bsiz];
os_swprintf(szError, bsiz, _W("%ls: An error occurred in '%ls' subroutine.\n").c_str(), L"intg", L"dqags");
os << szError;
throw ast::InternalError(os.str());
}
if (ier)
{
char* msg = NULL;
switch (ier)
{
case 1 :
{
msg = _("%s: Maximum number of subdivisions achieved. Splitting the interval might help.\n");
break;
}
case 2 :
{
msg = _("%s: Round-off error detected, the requested tolerance (or default) cannot be achieved. Try using bigger tolerances.\n");
break;
}
case 3 :
{
msg = _("%s: Bad integrand behavior occurs at some points of the integration interval.\n");
break;
}
case 4 :
{
msg = _("%s: Convergence problem, round-off error detected. Try using bigger tolerances.\n");
break;
}
case 5 :
{
msg = _("%s: The integral is probably divergent, or slowly convergent.\n");
break;
}
case 6 :
{
msg = _("%s: Invalid input, absolute tolerance <= 0 and relative tolerance < 2.e-14.\n");
break;
}
default :
msg = _("%s: Convergence problem...\n");
}
if (_iRetCount == 3)
{
if (getWarningMode())
{
sciprint(msg, "intg: Warning");
}
}
else
{
Scierror(999, msg, "intg: Error");
return types::Function::Error;
}
}
// *** Return result in Scilab. ***
types::Double* pDblOut = new types::Double(result);
out.push_back(pDblOut);
if (_iRetCount > 1)
{
out.push_back(new types::Double(abserr));
}
if (_iRetCount == 3)
{
out.push_back(new types::Double((double)ier));
}
return types::Function::OK;
}
vectGateway loadGatewaysName(const std::wstring& _wstModuleName)
{
vectGateway vect;
std::wstring wstPath = ConfigVariable::getSCIPath();
std::wstring wstModuleName = wstPath + L"/modules/" + _wstModuleName + L"/sci_gateway/" + _wstModuleName + L"_gateway.xml";
char* pstModuleName = wide_string_to_UTF8(wstModuleName.c_str());
/* Don't care about line return / empty line */
xmlKeepBlanksDefault(0);
// parse file
xmlDocPtr doc;
xmlXPathContextPtr xpathCtxt = NULL;
xmlXPathObjectPtr xpathObj = NULL;
doc = xmlParseFile(pstModuleName);
if (doc == NULL)
{
std::cout << "Error: Could not parse file " << pstModuleName << std::endl;
FREE(pstModuleName);
return vect;
}
FREE(pstModuleName);
xpathCtxt = xmlXPathNewContext(doc);
xpathObj = xmlXPathEval((const xmlChar*)"//module/gateway", xpathCtxt);
if (xpathObj && xpathObj->nodesetval->nodeMax)
{
/* the Xpath has been understood and there are node */
for (int i = 0 ; i < xpathObj->nodesetval->nodeNr ; i++)
{
GatewayStr str;
xmlAttrPtr attrib = xpathObj->nodesetval->nodeTab[i]->properties;
/* Get the properties of <module> */
while (attrib != NULL)
{
/* loop until when have read all the attributes */
if (xmlStrEqual(attrib->name, (const xmlChar*)"name"))
{
wchar_t * ws = to_wide_string((const char*)attrib->children->content);
str.wstName = ws;
FREE(ws);
}
else if (xmlStrEqual(attrib->name, (const xmlChar*)"function"))
{
wchar_t * ws = to_wide_string((const char*)attrib->children->content);
str.wstFunction = ws;
FREE(ws);
}
else if (xmlStrEqual(attrib->name, (const xmlChar*)"type"))
{
str.iType = (types::Function::FunctionType)atoi((const char*)attrib->children->content);
}
attrib = attrib->next;
}
vect.push_back(str);
}
}
if (xpathObj)
{
xmlXPathFreeObject(xpathObj);
}
if (xpathCtxt)
{
xmlXPathFreeContext(xpathCtxt);
}
xmlFreeDoc(doc);
return vect;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_feval(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
int iPos = 0;
int nn = 1;
int iErr = 0;
//input
types::Double* pDblX = NULL;
types::Double* pDblY = NULL;
// output
types::Double* pDblOut = NULL;
// error message catched
std::wostringstream os;
bool bCatch = false;
// *** check the minimal number of input args. ***
if (in.size() < 2 || in.size() > 3)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "feval", 2, 3);
return types::Function::Error;
}
// *** check number of output args according the methode. ***
if (_iRetCount > 1)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "feval", 1);
return types::Function::Error;
}
// *** check type of input args and get it. ***
// X
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
return types::Function::Error;
}
pDblX = in[iPos]->getAs<types::Double>();
if (pDblX->isComplex())
{
Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
return types::Function::Error;
}
iPos++;
// Y
if (in.size() == 3)
{
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
return types::Function::Error;
}
pDblY = in[iPos]->getAs<types::Double>();
if (pDblY->isComplex())
{
Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
return types::Function::Error;
}
iPos++;
nn = 2;
}
// function
DifferentialEquationFunctions deFunctionsManager(L"feval");
DifferentialEquation::addDifferentialEquationFunctions(&deFunctionsManager);
if (in[iPos]->isCallable())
{
types::Callable* pCall = in[iPos]->getAs<types::Callable>();
deFunctionsManager.setFFunction(pCall);
}
else if (in[iPos]->isString())
{
bool bOK = false;
types::String* pStr = in[iPos]->getAs<types::String>();
bOK = deFunctionsManager.setFFunction(pStr);
if (bOK == false)
{
char* pst = wide_string_to_UTF8(pStr->get(0));
Scierror(50, _("%s: Subroutine not found: %s\n"), "feval", pst);
FREE(pst);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
}
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"), "feval", iPos + 1, "(string empty)");
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
if (pList->get(0)->isCallable())
{
deFunctionsManager.setFFunction(pList->get(0)->getAs<types::Callable>());
for (int iter = 1; iter < pList->getSize(); iter++)
{
deFunctionsManager.setFArgs(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 Scilab function.\n"), "feval", 4);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d : A function expected.\n"), "feval", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
// *** Perform operation. ***
int itype = 0; // output value
double* res = (double*)MALLOC(2 * sizeof(double));
int sizeOfY = pDblY ? pDblY->getSize() : 1;
if (nn == 2)
{
pDblOut = new types::Double(pDblX->getSize(), sizeOfY);
}
else
{
pDblOut = new types::Double(pDblX->getRows(), pDblX->getCols());
}
for (int y = 0; y < sizeOfY; y++)
{
for (int x = 0; x < pDblX->getSize(); x++)
{
double valX = pDblX->get(x);
// if pDblY == NULL, nn == 1 so valY will be never used.
double valY = pDblY ? pDblY->get(y) : 0;
try
{
deFunctionsManager.execFevalF(&nn, &valX, &valY, res, &itype);
}
catch (ast::InternalError &ie)
{
os << ie.GetErrorMessage();
bCatch = true;
}
if (bCatch)
{
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(res);
delete pDblOut;
wchar_t szError[bsiz];
os_swprintf(szError, bsiz, _W("%s: An error occured in '%s' subroutine.\n").c_str(), "feval", "execFevalF");
os << szError;
throw ast::InternalError(os.str());
}
if (itype) // is complex
{
pDblOut->setComplex(true);
pDblOut->set(x + y * pDblX->getSize(), res[0]);
pDblOut->setImg(x + y * pDblX->getSize(), res[1]);
}
else
{
pDblOut->set(x + y * pDblX->getSize(), res[0]);
}
}
}
// *** Return result in Scilab. ***
out.push_back(pDblOut);
FREE(res);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_dasrt(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
// input args
types::Double* pDblX0 = NULL;
types::Double* pDblT0 = NULL;
types::Double* pDblT = NULL;
types::Double* pDblRtol = NULL;
types::Double* pDblAtol = NULL;
types::Double* pDblHd = NULL;
types::Double* pDblNg = NULL;
// x0 = [y0, ydot0]
double* pdYData = NULL; // contain y0 following by all args data in list case.
double* pdYdotData = NULL;
int sizeOfpdYData = 0;
int sizeOfYSize = 1;
int* YSize = NULL; // YSize(1) = size of y0,
// YSize(n) = size of Args(n) in list case.
int iPos = 0;
int one = 1;
int info[15] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
double tstop = 0;
double maxstep = 0;
double stepin = 0;
int ng = 0;
int mu = 0;
int ml = 0;
// Indicate if the function is given.
bool bFuncF = false;
bool bFuncJac = false;
bool bFuncG = false;
// Indicate if info list is given.
bool bListInfo = false;
// error message catched
std::wostringstream os;
bool bCatch = false;
// *** check the minimal number of input args. ***
if (in.size() < 6 || in.size() > 11)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "dasrt", 6, 11);
return types::Function::Error;
}
// *** check number of output args ***
if (_iRetCount != 3 && _iRetCount != 2)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d to %d expected.\n"), "dasrt", 2, 3);
return types::Function::Error;
}
// *** check type of input args and get it. ***
// x0 = [y0, yd0]
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "dasrt", iPos + 1);
return types::Function::Error;
}
pDblX0 = in[iPos]->getAs<types::Double>();
if (pDblX0->isComplex())
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "dasrt", iPos + 1);
return types::Function::Error;
}
if (pDblX0->getCols() > 2)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real matrix with %d to %d column(s) expected.\n"), "dasrt", iPos + 1, 1, 2);
return types::Function::Error;
}
if (pDblX0->getCols() == 1)
{
info[10] = 1;
}
// t0
iPos++;
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "dasrt", iPos + 1);
return types::Function::Error;
}
pDblT0 = in[iPos]->getAs<types::Double>();
if (pDblT0->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "dasrt", iPos + 1);
return types::Function::Error;
}
// t
iPos++;
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "dasrt", iPos + 1);
return types::Function::Error;
}
pDblT = in[iPos]->getAs<types::Double>();
if (pDblT->isComplex())
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "dasrt", iPos + 1);
return types::Function::Error;
}
// get next inputs
DifferentialEquationFunctions deFunctionsManager(L"dasrt");
DifferentialEquation::addDifferentialEquationFunctions(&deFunctionsManager);
YSize = (int*)MALLOC(sizeOfYSize * sizeof(int));
*YSize = pDblX0->getRows();
pdYData = (double*)MALLOC(*YSize * sizeof(double));
pdYdotData = (double*)MALLOC(*YSize * sizeof(double));
C2F(dcopy)(YSize, pDblX0->get(), &one, pdYData, &one);
if (pDblX0->getCols() == 2)
{
C2F(dcopy)(YSize, pDblX0->get() + *YSize, &one, pdYdotData, &one);
}
else
{
memset(pdYdotData, 0x00, *YSize);
}
deFunctionsManager.setOdeYRows(pDblX0->getRows());
for (iPos++; iPos < in.size(); iPos++)
{
if (in[iPos]->isDouble())
{
if (pDblAtol == NULL && bFuncF == false)
{
pDblAtol = in[iPos]->getAs<types::Double>();
if (pDblAtol->getSize() != pDblX0->getRows() && pDblAtol->isScalar() == false)
{
Scierror(267, _("%s: Wrong size for input argument #%d: A scalar or a matrix of size %d expected.\n"), "dasrt", iPos + 1, pDblX0->getRows());
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
else if (pDblRtol == NULL && bFuncF == false)
{
pDblRtol = in[iPos]->getAs<types::Double>();
if (pDblAtol->getSize() != pDblRtol->getSize())
{
Scierror(267, _("%s: Wrong size for input argument #%d: Atol and Rtol must have the same size.\n"), "dasrt", iPos + 1, pDblX0->getRows());
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
else if (pDblNg == NULL && bFuncF == true)
{
pDblNg = in[iPos]->getAs<types::Double>();
if (pDblNg->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
ng = (int)pDblNg->get(0);
}
else if (pDblHd == NULL && bFuncF == true)
{
pDblHd = in[iPos]->getAs<types::Double>();
if (in.size() != iPos + 1)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A function expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
else if (in[iPos]->isCallable())
{
types::Callable* pCall = in[iPos]->getAs<types::Callable>();
if (bFuncF == false)
{
deFunctionsManager.setFFunction(pCall);
bFuncF = true;
}
else if (bFuncJac == false && pDblNg == NULL)
{
deFunctionsManager.setJacFunction(pCall);
bFuncJac = true;
}
else if (bFuncG == false && pDblNg)
{
deFunctionsManager.setGFunction(pCall);
bFuncG = true;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix or a list expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
else if (in[iPos]->isString())
{
types::String* pStr = in[iPos]->getAs<types::String>();
bool bOK = false;
if (bFuncF == false)
{
bOK = deFunctionsManager.setFFunction(pStr);
bFuncF = true;
}
else if (bFuncJac == false && pDblNg == NULL)
{
bOK = deFunctionsManager.setJacFunction(pStr);
bFuncJac = true;
}
else if (bFuncG == false && pDblNg)
{
bOK = deFunctionsManager.setGFunction(pStr);
bFuncG = true;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix or a list expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
if (bOK == false)
{
char* pst = wide_string_to_UTF8(pStr->get(0));
Scierror(50, _("%s: Subroutine not found: %s\n"), "dasrt", pst);
FREE(pst);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
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"), "dasrt", iPos + 1, "(string empty)");
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
if (bFuncF && bListInfo)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
if (pList->get(0)->isString())
{
types::String* pStr = pList->get(0)->getAs<types::String>();
bool bOK = false;
if (bFuncF == false)
{
bFuncF = true;
bOK = deFunctionsManager.setFFunction(pStr);
sizeOfpdYData = *YSize;
}
else if (bFuncJac == false && pDblNg == NULL)
{
bFuncJac = true;
bOK = deFunctionsManager.setJacFunction(pStr);
if (sizeOfpdYData == 0)
{
sizeOfpdYData = *YSize;
}
}
else if (bFuncG == false && pDblNg)
{
bFuncG = true;
bOK = deFunctionsManager.setGFunction(pStr);
if (sizeOfpdYData == 0)
{
sizeOfpdYData = *YSize;
}
}
if (bOK == false)
{
char* pst = wide_string_to_UTF8(pStr->get(0));
Scierror(50, _("%s: Argument #%d: Subroutine not found in list: %s\n"), "dasrt", iPos + 1, pst);
FREE(pst);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
int* sizeTemp = YSize;
int totalSize = sizeOfpdYData;
YSize = (int*)MALLOC((sizeOfYSize + pList->getSize() - 1) * sizeof(int));
memcpy(YSize, sizeTemp, sizeOfYSize * sizeof(int));
std::vector<types::Double*> vpDbl;
for (int iter = 0; iter < pList->getSize() - 1; iter++)
{
if (pList->get(iter + 1)->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Argument %d in the list must be a matrix.\n"), "dasrt", iPos + 1, iter + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
vpDbl.push_back(pList->get(iter + 1)->getAs<types::Double>());
YSize[sizeOfYSize + iter] = vpDbl[iter]->getSize();
totalSize += YSize[sizeOfYSize + iter];
}
double* pdYDataTemp = pdYData;
pdYData = (double*)MALLOC(totalSize * sizeof(double));
C2F(dcopy)(&sizeOfpdYData, pdYDataTemp, &one, pdYData, &one);
int position = sizeOfpdYData;
for (int iter = 0; iter < pList->getSize() - 1; iter++)
{
C2F(dcopy)(&YSize[sizeOfYSize + iter], vpDbl[iter]->get(), &one, &pdYData[position], &one);
position += vpDbl[iter]->getSize();
}
vpDbl.clear();
sizeOfpdYData = totalSize;
sizeOfYSize += pList->getSize() - 1;
FREE(pdYDataTemp);
FREE(sizeTemp);
}
else if (pList->get(0)->isCallable())
{
if (bFuncF == false)
{
bFuncF = true;
deFunctionsManager.setFFunction(pList->get(0)->getAs<types::Callable>());
for (int iter = 1; iter < pList->getSize(); iter++)
{
deFunctionsManager.setFArgs(pList->get(iter)->getAs<types::InternalType>());
}
}
else if (bFuncJac == false && pDblNg == NULL)
{
bFuncJac = true;
deFunctionsManager.setJacFunction(pList->get(0)->getAs<types::Callable>());
for (int iter = 1; iter < pList->getSize(); iter++)
{
deFunctionsManager.setJacArgs(pList->get(iter)->getAs<types::InternalType>());
}
}
else if (bFuncG == false && pDblNg)
{
bFuncG = true;
deFunctionsManager.setGFunction(pList->get(0)->getAs<types::Callable>());
for (int iter = 1; iter < pList->getSize(); iter++)
{
deFunctionsManager.setGArgs(pList->get(iter)->getAs<types::InternalType>());
}
}
}
else if (pList->get(0)->isDouble() && bFuncF == true)
{
if (pList->getSize() != 7)
{
Scierror(267, _("%s: Wrong size for input argument #%d: A list of size %d expected.\n"), "dasrt", iPos + 1, 7);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
for (int i = 0; i < 7; i++) // info = list([],0,[],[],[],0,0)
{
if (pList->get(i)->isDouble() == false || (pList->get(i)->getAs<types::Double>()->isScalar() == false && (i == 1 || i == 5 || i == 6)))
{
if (i == 1 || i == 5 || i == 6)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Element %d in the info list must be a scalar.\n"), "dasrt", iPos + 1, i);
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: Element %d in the info list must be a matrix.\n"), "dasrt", iPos + 1, i);
}
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
types::Double* pDblTemp = pList->get(0)->getAs<types::Double>();
if (pDblTemp->getSize() != 0)
{
info[3] = 1;
tstop = pDblTemp->get(0);
}
info[2] = (int)pList->get(1)->getAs<types::Double>()->get(0);
pDblTemp = pList->get(2)->getAs<types::Double>();
if (pDblTemp->getSize() == 2)
{
info[5] = 1;
ml = (int)pDblTemp->get(0);
mu = (int)pDblTemp->get(1);
deFunctionsManager.setMl(ml);
deFunctionsManager.setMu(mu);
}
else if (pDblTemp->getSize() != 0)
{
Scierror(267, _("%s: Wrong size for input argument #%d: Argument %d in the list must be of size %d.\n"), "dasrt", iPos + 1, 3, 2);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
pDblTemp = pList->get(3)->getAs<types::Double>();
if (pDblTemp->getSize() != 0)
{
info[6] = 1;
maxstep = pDblTemp->get(0);
}
pDblTemp = pList->get(4)->getAs<types::Double>();
if (pDblTemp->getSize() != 0)
{
info[7] = 1;
stepin = pDblTemp->get(0);
}
info[9] = (int)pList->get(5)->getAs<types::Double>()->get(0);
if (pList->get(6)->getAs<types::Double>()->get(0) == 1)
{
info[10] = 1;
}
bListInfo = true;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: The first argument in the list must be a string, a function or a matrix in case of argument info.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix or a function expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
if (bFuncF == false)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "dasrt", in.size() + 3);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
if (pDblNg == NULL)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "dasrt", in.size() + 2);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
if (bFuncG == false)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "dasrt", in.size() + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
if (bFuncJac == true)
{
info[4] = 1;
}
// *** Initialization. ***
double t0 = pDblT0->get(0);
double rpar = 0;
int ipar = 0;
int idid = 0;
int maxord = 5;
//compute itol and set the tolerances rtol and atol.
double* rtol = NULL;
double* atol = NULL;
if (pDblAtol)
{
if (pDblAtol->isScalar())
{
atol = (double*)MALLOC(sizeof(double));
*atol = pDblAtol->get(0);
}
else
{
atol = pDblAtol->get();
info[1] = 1;
}
}
else
{
atol = (double*)MALLOC(sizeof(double));
*atol = 1.e-7;
}
if (pDblRtol)
{
if (pDblRtol->isScalar())
{
rtol = (double*)MALLOC(sizeof(double));
*rtol = pDblRtol->get(0);
}
else
{
rtol = pDblRtol->get();
}
}
else // if rtol is not given atol will be used as a scalar.
{
if (pDblAtol && pDblAtol->isScalar() == false) // info[1] == 1
{
double dblSrc = 1.e-9;
int iSize = pDblAtol->getSize();
int iOne = 1;
int iZero = 0;
rtol = (double*)MALLOC(iSize * sizeof(double));
C2F(dcopy)(&iSize, &dblSrc, &iZero, rtol, &iOne);
}
else
{
rtol = (double*)MALLOC(sizeof(double));
*rtol = 1.e-9;
}
}
// Compute rwork, iwork size.
// Create them.
int iworksize = 20 + pDblX0->getRows();
int rworksize = 0;
int* iwork = NULL;
double* rwork = NULL;
int* root = NULL;
if (info[5] == 0)
{
rworksize = 50 + (maxord + 4) * pDblX0->getRows() + pDblX0->getRows() * pDblX0->getRows() + 3 * ng;
}
else if (info[4] == 1)
{
rworksize = 50 + (maxord + 4) * pDblX0->getRows() + (2 * ml + mu + 1) * pDblX0->getRows() + 3 * ng;
}
else if (info[4] == 0)
{
rworksize = 50 + (maxord + 4) * pDblX0->getRows() + (2 * ml + mu + 1) * pDblX0->getRows() + 2 * (pDblX0->getRows() / (ml + mu + 1) + 1) + 3 * ng;
}
iwork = (int*)MALLOC(iworksize * sizeof(int));
rwork = (double*)MALLOC(rworksize * sizeof(double));
root = (int*)MALLOC(ng * sizeof(int));
if (pDblHd != NULL)
{
if (iworksize + rworksize != pDblHd->getSize())
{
Scierror(77, _("%s: Wrong size for input argument(s) %d: %d expected.\n"), "dasrt", in.size(), iworksize + rworksize);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
FREE(iwork);
FREE(rwork);
FREE(root);
if (pDblAtol == NULL || pDblAtol->isScalar())
{
FREE(atol);
}
if (pDblRtol == NULL || pDblRtol->isScalar())
{
FREE(rtol);
}
return types::Function::Error;
}
C2F(dcopy)(&rworksize, pDblHd->get(), &one, rwork, &one);
for (int i = 0; i < iworksize; i++)
{
iwork[i] = (int)pDblHd->get(rworksize + i);
}
info[0] = 1;
}
if (info[3] == 1)
{
rwork[0] = tstop;
}
if (info[6] == 1)
{
rwork[1] = maxstep;
}
if (info[7] == 1)
{
rwork[2] = stepin;
}
if (info[5] == 1)
{
iwork[0] = ml;
iwork[1] = mu;
}
// *** Perform operation. ***
std::list<types::Double*> lpDblOut;
int size = pDblX0->getRows();
int rowsOut = 1 + pDblX0->getRows() * 2;
int iret = 0;
for (int i = 0; i < pDblT->getSize(); i++)
{
types::Double* pDblOut = new types::Double(rowsOut, 1);
lpDblOut.push_back(pDblOut);
double t = pDblT->get(i);
int pos = 0;
pDblOut->set(pos, t);
if (t == t0)
{
pos++;
C2F(dcopy)(&size, pdYData, &one, pDblOut->get() + pos, &one);
pos += pDblX0->getRows();
C2F(dcopy)(&size, pdYdotData, &one, pDblOut->get() + pos, &one);
continue;
}
try
{
C2F(ddasrt)(dassl_f, YSize, &t0, pdYData, pdYdotData, &t, info, rtol, atol, &idid, rwork, &rworksize, iwork, &iworksize, &rpar, &ipar, dassl_jac, dasrt_g, &ng, root);
iret = checkError(idid, "dasrt");
if (iret == 1) // error
{
Scierror(999, _("%s: %s return with state %d.\n"), "dasrt", "ddasrt", idid);
}
}
catch (ast::InternalError &ie)
{
os << ie.GetErrorMessage();
bCatch = true;
iret = 1;
}
if (iret == 1)
{
lpDblOut.clear();
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
FREE(iwork);
FREE(rwork);
FREE(root);
if (pDblAtol == NULL || pDblAtol->isScalar())
{
FREE(atol);
}
if (pDblRtol == NULL || pDblRtol->isScalar())
{
FREE(rtol);
}
if (bCatch)
{
wchar_t szError[bsiz];
os_swprintf(szError, bsiz, _W("%ls: An error occured in '%ls' subroutine.\n").c_str(), L"dasrt", L"ddasrt");
os << szError;
throw ast::InternalError(os.str());
}
return types::Function::Error;
}
pos++;
C2F(dcopy)(&size, pdYData, &one, pDblOut->get() + pos, &one);
pos += size;
C2F(dcopy)(&size, pdYdotData, &one, pDblOut->get() + pos, &one);
if (iret == 2) // warning
{
pDblOut->set(0, t0);
break;
}
// iret == 0
if (idid == 1)
{
pDblOut->set(0, t0);
i--;
}
else if (idid == -2)
{
t0 = t;
i--;
}
else
{
t0 = t;
}
info[0] = 1;
}
// *** Return result in Scilab. ***
types::Double* pDblOut = new types::Double(rowsOut, (int)lpDblOut.size());
int sizeOfList = (int)lpDblOut.size();
for (int i = 0; i < sizeOfList; i++)
{
int pos = i * rowsOut;
C2F(dcopy)(&rowsOut, lpDblOut.front()->get(), &one, pDblOut->get() + pos, &one);
lpDblOut.pop_front();
}
out.push_back(pDblOut);
int sizeOfRoot = 1;
for (int i = 0; i < ng; i++)
{
if (root[i])
{
sizeOfRoot++;
}
}
types::Double* pDblRoot = new types::Double(1, sizeOfRoot);
pDblRoot->set(0, t0);
int j = 0;
for (int i = 0; i < ng; i++)
{
if (root[i])
{
j++;
pDblRoot->set(j, i + 1);
}
}
out.push_back(pDblRoot);
if (_iRetCount == 3)
{
types::Double* pDblHdOut = new types::Double(rworksize + iworksize, 1);
C2F(dcopy)(&rworksize, rwork, &one, pDblHdOut->get(), &one);
for (int i = 0; i < iworksize; i++)
{
pDblHdOut->set(rworksize + i, (double)iwork[i]);
}
out.push_back(pDblHdOut);
}
// *** FREE. ***
if (pDblAtol == NULL || pDblAtol->isScalar())
{
FREE(atol);
}
if (pDblRtol == NULL || pDblRtol->isScalar())
{
FREE(rtol);
}
FREE(pdYData);
FREE(pdYdotData);
FREE(YSize);
FREE(rwork);
FREE(iwork);
FREE(root);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::OK;
}
