types::Function::ReturnValue sci_pointer_xproperty(types::typed_list &in, int _iRetCount, types::typed_list &out) { if (in.size() != 0) { Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), funname.data(), 0); return types::Function::Error; } if (_iRetCount > 1) { Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), funname.data(), 1); return types::Function::Error; } const int isrun = C2F(cosim).isrun; if (!isrun) { Scierror(999, _("%s: scicosim is not running.\n"), funname.data()); return types::Function::Error; } // Retrieve the current block's continuous state and copy it to the return const int* pointer_xproperty = get_pointer_xproperty(); const int npointer_xproperty = get_npointer_xproperty(); double* data; types::Double* ret = new types::Double(npointer_xproperty, 1, &data); #ifdef _MSC_VER std::transform(pointer_xproperty, pointer_xproperty + npointer_xproperty, stdext::checked_array_iterator<double*>(data, npointer_xproperty), toDouble); #else std::transform(pointer_xproperty, pointer_xproperty + npointer_xproperty, data, toDouble); #endif out.push_back(ret); return types::Function::OK; }
types::Function::ReturnValue sci_host(types::typed_list &in, int _iRetCount, types::typed_list &out) { if (in.size() != 1) { Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "host", 1); return Function::Error; } types::InternalType* pIT = in[0]; if (pIT->isString() == false || pIT->getAs<types::String>()->getSize() != 1) { Scierror(89, _("%s: Wrong size for input argument #%d: A string expected.\n"), "host", 1); return Function::Error; } wchar_t* pstCommand = pIT->getAs<types::String>()->get(0); int stat = 0; systemcW(pstCommand, &stat); out.push_back(new types::Double(stat)); return Function::OK; }
types::Function::ReturnValue sci_diffobjs(types::typed_list &in, int _iRetCount, types::typed_list &out) { if (in.size() != 2) { Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), funname.data(), 2); return types::Function::Error; } if (_iRetCount > 1) { Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), funname.data(), 1); return types::Function::Error; } types::Double* ret = new types::Double(1); if (*in[0] == *in[1]) { ret->set(0, 0); } out.push_back(ret); return types::Function::OK; }
Function::ReturnValue sci_isglobal(types::typed_list &in, int _iRetCount, types::typed_list &out) { types::typed_list::iterator inIterator; int iWrongType = 1; if (in.size() != 1) { Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "isglobal", 1); return Function::Error; } else { if (in[0]->isString() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: Single string expected.\n"), "isglobal", 1); return Function::Error; } String* pS = in[0]->getAs<types::String>(); if (pS->isScalar() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: Single string expected.\n"), "isglobal", 1); return Function::Error; } if (symbol::Context::getInstance()->isGlobalVisible(symbol::Symbol(pS->get(0)))) { out.push_back(new types::Bool(1)); } else { out.push_back(new types::Bool(0)); } } return Function::OK; }
types::Function::ReturnValue intString(T* pInt, types::typed_list &out) { int iDims = pInt->getDims(); int* piDimsArray = pInt->getDimsArray(); types::String *pstOutput = new types::String(iDims, piDimsArray); int iSize = pInt->getSize(); for (int i = 0 ; i < iSize ; i++) { std::wostringstream ostr; DoubleComplexMatrix2String(&ostr, (double)pInt->get(i), 0); pstOutput->set(i, ostr.str().c_str()); } out.push_back(pstOutput); return types::Function::OK; }
/*--------------------------------------------------------------------------*/ 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; }
/*--------------------------------------------------------------------------*/ types::Function::ReturnValue sci_zeros(types::typed_list &in, int _iRetCount, types::typed_list &out) { types::Double* pOut = NULL; int iDims = 0; int* piDims = NULL; bool alloc = false; bool ret = getDimsFromArguments(in, "zeros", &iDims, &piDims, &alloc); if (ret == false) { switch (iDims) { case -1: Scierror(21, _("Invalid index.\n")); break; case 1: { //call overload ast::ExecVisitor exec; return Overload::generateNameAndCall(L"zeros", in, _iRetCount, out, &exec); } } return types::Function::Error; } pOut = new Double(iDims, piDims); if (alloc) { delete[] piDims; } pOut->setZeros(); out.push_back(pOut); return types::Function::OK; }
types::Function::ReturnValue sci_end_scicosim(types::typed_list &in, int _iRetCount, types::typed_list &/*out*/) { if (in.size() != 0) { Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), funname.data(), 0); return types::Function::Error; } if (_iRetCount > 1) { Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), funname.data(), 1); return types::Function::Error; } const int isrun = C2F(cosim).isrun; if (!isrun) { Scierror(999, _("%s: scicosim is not running.\n"), funname.data()); return types::Function::Error; } end_scicos_sim(); return types::Function::OK; }
types::Function::ReturnValue sci_pause(types::typed_list &in, int _iRetCount, types::typed_list &out) { if (ConfigVariable::getEnableDebug() == true) { sciprint(_("%s: function is disabled in debug mode.\n"), "pause"); return types::Function::OK; } if (in.size() != 0) { Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "pause", 0); return types::Function::Error; } ConfigVariable::IncreasePauseLevel(); // unlock console thread to display prompt again ThreadManagement::SendConsoleExecDoneSignal(); //return to console so change mode to 2 int iOldMode = ConfigVariable::getPromptMode(); ConfigVariable::setPromptMode(2); int iPauseLevel = ConfigVariable::getPauseLevel(); while (ConfigVariable::getPauseLevel() == iPauseLevel) { ThreadManagement::SendAwakeRunnerSignal(); ThreadManagement::WaitForRunMeSignal(); StaticRunner_launch(); } //return from console so change mode to initial ConfigVariable::setPromptMode(iOldMode); return types::Function::OK; }
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; }
/*--------------------------------------------------------------------------*/ 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_inv(types::typed_list &in, int _iRetCount, types::typed_list &out) { types::Double* pDbl = NULL; double* pData = NULL; int ret = 0; if (in.size() != 1) { Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "inv", 1); return types::Function::Error; } if ((in[0]->isDouble() == false)) { std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_inv"; return Overload::call(wstFuncName, in, _iRetCount, out); } pDbl = in[0]->getAs<types::Double>()->clone()->getAs<types::Double>(); // input data will be modified if (pDbl->getRows() != pDbl->getCols()) { Scierror(20, _("%s: Wrong type for argument %d: Square matrix expected.\n"), "inv", 1); return types::Function::Error; } if (pDbl->getRows() == 0) { out.push_back(types::Double::Empty()); return types::Function::OK; } if (pDbl->isComplex()) { /* c -> z */ pData = (double*)oGetDoubleComplexFromPointer( pDbl->getReal(), pDbl->getImg(), pDbl->getSize()); } else { pData = pDbl->getReal(); } if (pDbl->getCols() == -1) { pData[0] = 1. / pData[0]; } else { double dblRcond; ret = iInvertMatrixM(pDbl->getRows(), pDbl->getCols(), pData, pDbl->isComplex(), &dblRcond); if (pDbl->isComplex()) { /* z -> c */ vGetPointerFromDoubleComplex((doublecomplex*)pData, pDbl->getSize(), pDbl->getReal(), pDbl->getImg()); vFreeDoubleComplexFromPointer((doublecomplex*)pData); } if (ret == -1) { if (getWarningMode()) { sciprint(_("Warning :\n")); sciprint(_("matrix is close to singular or badly scaled. rcond = %1.4E\n"), dblRcond); } } } if (ret == 19) { Scierror(19, _("%s: Problem is singular.\n"), "inv"); return types::Function::Error; } out.push_back(pDbl); return types::Function::OK; }
types::Function::ReturnValue sci_mopen(types::typed_list &in, int _iRetCount, types::typed_list &out) { int iErr = 0; int iID = 0; wchar_t* pstFilename = NULL; const wchar_t* pstMode = L"rb"; int iSwap = 0; //check output parameters if (_iRetCount != 1 && _iRetCount != 2) { Scierror(78, _("%s: Wrong number of output argument(s): %d to %d expected.\n"), "mopen", 1, 2); return types::Function::Error; } //check input parameters if (in.size() >= 1) { //filename if (in[0]->isString() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), "mopen", 1); return types::Function::Error; } types::String* pS1 = in[0]->getAs<types::String>(); if (pS1->getSize() != 1) { Scierror(999, _("%s: Wrong size for input argument #%d: string expected.\n"), "mopen" , 1); return types::Function::Error; } pstFilename = expandPathVariableW(pS1->get(0)); if (in.size() >= 2) { //mode if (in[1]->isString() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), "mopen", 2); return types::Function::Error; } types::String* pS2 = in[1]->getAs<types::String>(); if (pS2->getSize() != 1) { Scierror(999, _("%s: Wrong size for input argument #%d: string expected.\n"), "mopen" , 2); return types::Function::Error; } pstMode = pS2->get(0); if (in.size() >= 3) { //swap if (in[2]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: An integer expected.\n"), "mopen" , 3); return types::Function::Error; } types::Double* pD3 = in[2]->getAs<types::Double>(); if (pD3->getSize() != 1 || pD3->isComplex()) { Scierror(999, _("%s: Wrong size for input argument #%d: An integer expected.\n"), "mopen", 3); return types::Function::Error; } //if value == 0 set swap to 0 otherwise let to 1 if (pD3->getReal(0, 0) == 0) { iSwap = 0; } if (in.size() >= 4) { Scierror(999, _("%s: Wrong number of input arguments: %d to %d expected.\n"), "mopen" , 1, 3); return types::Function::Error; } } } } else { Scierror(999, _("%s: Wrong number of input arguments: %d to %d expected.\n"), "mopen" , 1, 3); return types::Function::Error; } wchar_t* pwstTemp = (wchar_t*)MALLOC(sizeof(wchar_t) * (PATH_MAX * 2)); get_full_pathW(pwstTemp, (const wchar_t*)pstFilename, PATH_MAX * 2); iErr = mopen(pwstTemp, pstMode, iSwap, &iID); if (iErr != MOPEN_NO_ERROR) { //mange file open errors if (_iRetCount == 1) { switch (iErr) { case MOPEN_CAN_NOT_OPEN_FILE: { char* pst = wide_string_to_UTF8(pstFilename); Scierror(999, _("%s: Cannot open file %s.\n"), "mopen", pst); FREE(pst); FREE(pstFilename); FREE(pwstTemp); pstFilename = NULL; return types::Function::Error; } case MOPEN_INVALID_FILENAME: { Scierror(999, _("%s: invalid filename.\n"), "mopen"); FREE(pstFilename); FREE(pwstTemp); pstFilename = NULL; return types::Function::Error; } case MOPEN_INVALID_STATUS: { Scierror(999, _("%s: invalid status.\n"), "mopen"); FREE(pstFilename); FREE(pwstTemp); pstFilename = NULL; return types::Function::Error; } } } } FREE(pwstTemp); FREE(pstFilename); types::Double* pD = new types::Double(static_cast<double>(iID)); out.push_back(pD); if (_iRetCount == 2) { types::Double* pD2 = new types::Double(iErr); out.push_back(pD2); } return types::Function::OK; }
types::Function::ReturnValue sci_newest(types::typed_list &in, int _iRetCount, types::typed_list &out) { int iRet = 0; int iNbrString = 0; wchar_t** pwcsStringInput = NULL; if (in.size() == 0) { out.push_back(types::Double::Empty()); return types::Function::OK; } if (in.size() == 1) { if (in[0]->isString() == FALSE) { if (in[0]->getAs<types::GenericType>()->getSize() == 0) { out.push_back(types::Double::Empty()); return types::Function::OK; } else { Scierror(999, _("%s: Wrong type for input argument #%d: A String(s) expected.\n"), "newest", 1); return types::Function::Error; } } if (in[0]->getAs<types::String>()->isScalar()) { out.push_back(new types::Double(1)); return types::Function::OK; } else { int size = in[0]->getAs<types::String>()->getSize(); pwcsStringInput = (wchar_t**)MALLOC(size * sizeof(wchar_t*)); for (iNbrString = 0; iNbrString < size; iNbrString++) { pwcsStringInput[iNbrString] = in[0]->getAs<types::String>()->get(iNbrString); } iRet = newest(pwcsStringInput, iNbrString); FREE(pwcsStringInput); out.push_back(new types::Double(iRet)); } } else { int size = (int)in.size(); pwcsStringInput = (wchar_t**)MALLOC(size * sizeof(wchar_t*)); for (iNbrString = 0; iNbrString < size; iNbrString++) { if (in[iNbrString]->isString() == FALSE) { FREE(pwcsStringInput); Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), "newest", iNbrString + 1); return types::Function::Error; } pwcsStringInput[iNbrString] = in[iNbrString]->getAs<types::String>()->get(0); } if (in[1]->getAs<types::String>()->isScalar() == false) { FREE(pwcsStringInput); Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), "newest", 2); return types::Function::Error; } iRet = newest(pwcsStringInput, iNbrString); FREE(pwcsStringInput); out.push_back(new types::Double((double)iRet)); } return types::Function::OK; }
/*--------------------------------------------------------------------------*/ types::Function::ReturnValue sci_abs(types::typed_list &in, int _iRetCount, types::typed_list &out) { if (in.size() != 1) { Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "abs", 1); return types::Function::Error; } if (_iRetCount > 1) { Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "abs", 1); return types::Function::Error; } switch (in[0]->getType()) { case types::InternalType::ScilabDouble: { api_scilab::Double* pDblIn = api_scilab::getAsDouble(in[0]); api_scilab::Double* pDblOut = new api_scilab::Double(pDblIn->getDims(), pDblIn->getDimsArray()); double* pdblInR = pDblIn->get(); double* pdblInI = pDblIn->getImg(); double* pdblOut = pDblOut->get(); int size = pDblIn->getSize(); if (pDblIn->isComplex()) { for (int i = 0; i < size; i++) { if (ISNAN(pdblInR[i])) { pdblOut[i] = pdblInR[i]; } else if (ISNAN(pdblInI[i])) { pdblOut[i] = pdblInI[i]; } else { pdblOut[i] = dabsz(pdblInR[i], pdblInI[i]); } } } else { for (int i = 0; i < size; i++) { if (ISNAN(pdblInR[i])) { pdblOut[i] = pdblInR[i]; } else { pdblOut[i] = std::fabs(pdblInR[i]); } } } out.push_back(api_scilab::getReturnVariable(pDblOut)); delete pDblOut; delete pDblIn; break; } case types::InternalType::ScilabPolynom: { types::Polynom* pPolyIn = in[0]->getAs<types::Polynom>(); types::Polynom* pPolyOut = new types::Polynom(pPolyIn->getVariableName(), pPolyIn->getDims(), pPolyIn->getDimsArray()); double* data = NULL; if (pPolyIn->isComplex()) { for (int i = 0; i < pPolyIn->getSize(); i++) { int rank = pPolyIn->get(i)->getRank(); types::SinglePoly* pSP = new types::SinglePoly(&data, rank); for (int j = 0; j < rank + 1; j++) { data[j] = dabsz(pPolyIn->get(i)->get()[j], pPolyIn->get(i)->getImg()[j]); } pPolyOut->set(i, pSP); delete pSP; pSP = NULL; } } else { for (int i = 0; i < pPolyIn->getSize(); i++) { int rank = pPolyIn->get(i)->getRank(); types::SinglePoly* pSP = new types::SinglePoly(&data, rank); for (int j = 0; j < rank + 1; j++) { data[j] = dabss(pPolyIn->get(i)->get()[j]); } pPolyOut->set(i, pSP); delete pSP; pSP = NULL; } } out.push_back(pPolyOut); break; } case types::InternalType::ScilabInt8: { out.push_back(absInt(in[0]->getAs<types::Int8>())); break; } case types::InternalType::ScilabInt16: { out.push_back(absInt(in[0]->getAs<types::Int16>())); break; } case types::InternalType::ScilabInt32: { out.push_back(absInt(in[0]->getAs<types::Int32>())); break; } case types::InternalType::ScilabInt64: { out.push_back(absInt(in[0]->getAs<types::Int64>())); break; } case types::InternalType::ScilabUInt8: case types::InternalType::ScilabUInt16: case types::InternalType::ScilabUInt32: case types::InternalType::ScilabUInt64: { out.push_back(in[0]); break; } default: { std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_abs"; return Overload::call(wstFuncName, in, _iRetCount, out); } } return types::Function::OK; }
/*--------------------------------------------------------------------------*/ types::Function::ReturnValue sci_diag(types::typed_list &in, int _iRetCount, types::typed_list &out) { int iStartPos = 0; if (in.size() < 1 || in.size() > 2) { Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "diag", 1, 2); return types::Function::Error; } if (_iRetCount > 1) { Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "diag", 1); return types::Function::Error; } if (in[0]->isGenericType() == false) { ast::ExecVisitor exec; std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_diag"; return Overload::call(wstFuncName, in, _iRetCount, out, &exec); } if (in[0]->getAs<types::GenericType>()->getDims() > 2) { ast::ExecVisitor exec; std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_diag"; return Overload::call(wstFuncName, in, _iRetCount, out, &exec); } if (in.size() == 2) { if (in[1]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d : A real scalar expected.\n"), "diag", 2); return types::Function::Error; } types::Double* pDbl = in[1]->getAs<types::Double>(); if (pDbl->isScalar() == false || pDbl->isComplex()) { Scierror(999, _("%s: Wrong type for input argument #%d : A real scalar expected.\n"), "diag", 2); return types::Function::Error; } iStartPos = static_cast<int>(pDbl->get(0)); } switch (in[0]->getType()) { case types::InternalType::ScilabDouble : out.push_back(diag<types::Double, double>(in[0]->getAs<types::Double>(), iStartPos)); break; case types::InternalType::ScilabPolynom : out.push_back(diag(in[0]->getAs<types::Polynom>(), iStartPos)); break; case types::InternalType::ScilabString : out.push_back(diag(in[0]->getAs<types::String>(), iStartPos)); break; case types::InternalType::ScilabBool : out.push_back(diag<types::Bool, int>(in[0]->getAs<types::Bool>(), iStartPos)); break; case types::InternalType::ScilabInt8 : out.push_back(diag<types::Int8, char>(in[0]->getAs<types::Int8>(), iStartPos)); break; case types::InternalType::ScilabInt16 : out.push_back(diag<types::Int16, short>(in[0]->getAs<types::Int16>(), iStartPos)); break; case types::InternalType::ScilabInt32 : out.push_back(diag<types::Int32, int>(in[0]->getAs<types::Int32>(), iStartPos)); break; case types::InternalType::ScilabInt64 : out.push_back(diag<types::Int64, long long>(in[0]->getAs<types::Int64>(), iStartPos)); break; case types::InternalType::ScilabUInt8 : out.push_back(diag<types::UInt8, unsigned char>(in[0]->getAs<types::UInt8>(), iStartPos)); break; case types::InternalType::ScilabUInt16 : out.push_back(diag<types::UInt16, unsigned short>(in[0]->getAs<types::UInt16>(), iStartPos)); break; case types::InternalType::ScilabUInt32 : out.push_back(diag<types::UInt32, unsigned int>(in[0]->getAs<types::UInt32>(), iStartPos)); break; case types::InternalType::ScilabUInt64 : out.push_back(diag<types::UInt64, unsigned long long>(in[0]->getAs<types::UInt64>(), iStartPos)); break; default : { ast::ExecVisitor exec; std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_diag"; return Overload::call(wstFuncName, in, _iRetCount, out, &exec); } } return types::Function::OK; }
/*--------------------------------------------------------------------------*/ types::Function::ReturnValue sci_file_no_rhs(types::typed_list &in, int _iRetCount, types::typed_list &out) { int iCount = FileManager::getOpenedCount(); if (iCount == 0) { for (int i = 0 ; i < _iRetCount ; i++) { out.push_back(types::Double::Empty()); } return types::Function::OK; } int* piIds = FileManager::getIDs(); if (piIds) { types::Double *pD = new types::Double(1, iCount); pD->setInt(piIds); out.push_back(pD); delete[] piIds; } if (_iRetCount > 1) /*types*/ { wchar_t** pstTypes = FileManager::getTypesAsString(); if (pstTypes != NULL) { types::String* pS = new types::String(1, iCount); pS->set(pstTypes); out.push_back(pS); for (int i = 0 ; i < iCount ; i++) { delete[] pstTypes[i]; } delete[] pstTypes; } } if (_iRetCount > 2) /*names*/ { wchar_t** pstNames = FileManager::getFilenames(); if (pstNames != NULL) { types::String* pS = new types::String(1, iCount); pS->set(pstNames); out.push_back(pS); for (int i = 0 ; i < iCount ; i++) { delete[] pstNames[i]; } delete[] pstNames; } } if (_iRetCount > 3) /* mod */ { double* pdblModes = FileManager::getModes(); if (pdblModes != NULL) { types::Double* pD = new types::Double(1, iCount); pD->set(pdblModes); out.push_back(pD); delete[] pdblModes; } } if (_iRetCount > 4) /* swap */ { double* pdblSwaps = FileManager::getSwaps(); if (pdblSwaps != NULL) { types::Double* pD = new types::Double(1, iCount); pD->set(pdblSwaps); out.push_back(pD); delete[] pdblSwaps; } } 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; }
/*--------------------------------------------------------------------------*/ types::Function::ReturnValue sci_file(types::typed_list &in, int _iRetCount, types::typed_list &out) { types::String* pSAction = NULL; if (in.size() > 6) { Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "file", 0, 6); return types::Function::Error; } if (in.size() == 0) { return sci_file_no_rhs(in, _iRetCount, out); } if (in.size() == 1) { return sci_file_one_rhs(in, _iRetCount, out); } // get action if (in[0]->isString() == false) { Scierror(999, _("%s: Wrong type for input argument #%d : string expected.\n"), "file", 1); return types::Function::Error; } pSAction = in[0]->getAs<types::String>(); if (pSAction->isScalar() == false) { Scierror(999, _("%s: Wrong type for input argument #%d : A single string expected.\n"), "file", 1); return types::Function::Error; } if (wcscmp(pSAction->get(0), L"open") == 0) { types::String* pSPath = NULL; types::String* pSOption = NULL; types::Double* pSRecl = NULL; int iStatus = 0; int iAccess = 0; int iForm = 0; int iRecl = 0; int piMode[2] = {0, 0}; // get path if (in[1]->isString() == false) { Scierror(999, _("%s: Wrong type for input argument #%d : string expected.\n"), "file", 2); return types::Function::Error; } pSPath = in[1]->getAs<types::String>(); if (pSPath->isScalar() == false) { Scierror(999, _("%s: Wrong type for input argument #%d : A single string expected.\n"), "file", 2); return types::Function::Error; } // get optional inputs for (int i = 2; i < in.size(); i++) { if (in[i]->isString()) { pSOption = in[i]->getAs<types::String>(); } else if (i != 2 && in[i]->isDouble()) { pSRecl = in[i]->getAs<types::Double>(); if (pSRecl->isScalar() == false) { Scierror(999, _("%s: Wrong type for input argument #%d : A scalar expected.\n"), "file", i + 1); return types::Function::Error; } iRecl = (int)pSRecl->get(0); piMode[1] = iRecl; continue; } else { Scierror(999, _("%s: Wrong type for input argument #%d : string expected.\n"), "file", i + 1); return types::Function::Error; } if (pSOption->isScalar() == false) { Scierror(999, _("%s: Wrong type for input argument #%d : A single string expected.\n"), "file", i + 1); return types::Function::Error; } if (wcscmp(pSOption->get(0), L"new") == 0) { iStatus = 0; } else if (wcscmp(pSOption->get(0), L"old") == 0) { iStatus = 1; // file must already exists. if (FileExistW(pSPath->get(0)) == false) { if (_iRetCount == 2) { out.push_back(types::Double::Empty()); out.push_back(new types::Double(240)); return types::Function::OK; } else { char* pstrFilename = wide_string_to_UTF8(pSPath->get(0)); if (pstrFilename) { Scierror(240, _("%s: The file \"%s\" does not exist.\n"), "file", pstrFilename); FREE(pstrFilename); pstrFilename = NULL; } else { Scierror(240, _("%s: The file does not exist.\n"), "file"); } return types::Function::Error; } } } else if (wcscmp(pSOption->get(0), L"scratch") == 0) { iStatus = 2; } else if (wcscmp(pSOption->get(0), L"unknown") == 0) { iStatus = 3; } else if (wcscmp(pSOption->get(0), L"sequential") == 0) { iAccess = 0; } else if (wcscmp(pSOption->get(0), L"direct") == 0) { iAccess = 1; } else if (wcscmp(pSOption->get(0), L"formatted") == 0) { iForm = 0; } else if (wcscmp(pSOption->get(0), L"unformatted") == 0) { iForm = 1; } else { Scierror(999, _("%s: Wrong value for input argument #%d.\n"), "file", i + 1); return types::Function::Error; } } piMode[0] = iStatus + 10 * (iAccess + 10 * iForm); int lunit = 0; // file unit. 0 mean we open the file by this name. char* pstFilename = wide_string_to_UTF8(pSPath->get(0)); int iErr = C2F(clunit)(&lunit, pstFilename, piMode, (int)strlen(pstFilename)); if (iErr) { if (_iRetCount == 1) { switch (iErr) { case 65 : Scierror(iErr, _("%s: %d logical unit already used.\n"), "file", lunit); break; case 66 : Scierror(iErr, _("%s: Too many files opened!\n"), "file"); break; case 67 : Scierror(iErr, _("%s: Unknown file format.\n"), "file"); break; case 240 : Scierror(iErr, _("%s: File \"%s\" already exists or directory write access denied.\n"), "file", pstFilename); break; case 241 : Scierror(iErr, _("%s: File \"%s\" does not exist or read access denied.\n"), "file", pstFilename); break; default : Scierror(iErr, _("%s: Can not open File \"%s\"\n"), "file", pstFilename); } return types::Function::Error; } else { out.push_back(types::Double::Empty()); out.push_back(new types::Double((double)iErr)); return types::Function::OK; } } out.push_back(new types::Double((double)lunit)); if (_iRetCount == 2) { out.push_back(new types::Double(0.0)); } FREE(pstFilename); } else if (wcscmp(pSAction->get(0), L"close") == 0 || wcscmp(pSAction->get(0), L"rewind") == 0 || wcscmp(pSAction->get(0), L"backspace") == 0 || wcscmp(pSAction->get(0), L"last") == 0) { if (_iRetCount != 1) { Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "file", 1); return types::Function::Error; } if (in.size() != 2) { Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "file", 2); return types::Function::Error; } if (in[1]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d : A matrix expected.\n"), "file", 2); return types::Function::Error; } types::Double* pDblFileUnit = in[1]->getAs<types::Double>(); double* pdblUnit = pDblFileUnit->get(); if (wcscmp(pSAction->get(0), L"close") == 0) { for (int i = 0; i < pDblFileUnit->getSize(); i++) { int iErr = mclose((int)(pdblUnit[i])); if (iErr) { Scierror(999, _("%s: Cannot close file %d.\n"), "file", (int)pdblUnit[i]); return types::Function::Error; } } } else if (wcscmp(pSAction->get(0), L"rewind") == 0) { int iFileUnit = (int)pdblUnit[0]; types::File* pFile = FileManager::getFile(iFileUnit); if (pFile && pFile->getFileType() == 2) { mseek(iFileUnit, 0, SEEK_SET); } else if (pFile && pFile->getFileType() == 1) { C2F(rewindinter)(&iFileUnit); } else { Scierror(999, _("%s: Unknown file format.\n"), "file"); return types::Function::Error; } } else if (wcscmp(pSAction->get(0), L"backspace") == 0) { int iFileUnit = (int)pdblUnit[0]; types::File* pFile = FileManager::getFile(iFileUnit); if (pFile && pFile->getFileType() == 2) { Scierror(999, _("%s: Wrong input argument #%d.\n"), "file", 1); return types::Function::Error; } else if (pFile && pFile->getFileType() == 1) { C2F(backspaceinter)(&iFileUnit); } else { Scierror(67, _("%s: Unknown file format.\n"), "file"); return types::Function::Error; } } else if (wcscmp(pSAction->get(0), L"last") == 0) { int iFileUnit = (int)pdblUnit[0]; types::File* pFile = FileManager::getFile(iFileUnit); if (pFile && pFile->getFileType() == 2) { mseek(iFileUnit, 0, SEEK_END); } else if (pFile && pFile->getFileType() == 1) { int iErr = 0; while (iErr == 0) { iErr = C2F(readinter)(&iFileUnit, "(a)", 1L); } if (iErr == 2) { Scierror(999, _("%s: \n"), "file"); return types::Function::Error; } C2F(backspaceinter)(&iFileUnit); } else { Scierror(67, _("%s: Unknown file format.\n"), "file"); return types::Function::Error; } } } else { Scierror(49, _("%s: Wrong value for input argument #%d: \"%s\", \"%s\", \"%s\", \"%s\", \"%s\" \n"), "file", 1, "open", "close", "rewind", "backspace", "last"); return types::Function::Error; } return types::Function::OK; }
types::Function::ReturnValue sci_scicos_setfield(types::typed_list &in, int _iRetCount, types::typed_list &out) { if (in.size() != 3) { Scierror(999, _("%s: Wrong number of input arguments: %d expected.\n"), funame.data(), 3); return types::Function::Error; } if (_iRetCount != 1) { Scierror(999, _("%s: Wrong number of output arguments: %d expected.\n"), funame.data(), 1); return types::Function::Error; } types::InternalType* field_type = in[0]; if (field_type->getType() != types::InternalType::ScilabString) { Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), funame.data(), 1); return types::Function::Error; } types::String* field_name = field_type->getAs<types::String>(); if (field_name->getSize() > 1) { Scierror(999, _("%s: Wrong size for input argument #%d: String expected.\n"), funame.data(), 1); return types::Function::Error; } std::wstring field = field_name->get(0); types::InternalType* value = in[1]; types::InternalType* adaptor = in[2]; /* * allocate the right adapter then try to set fields values */ const view_scilab::Adapters::adapters_index_t adapter_index = view_scilab::Adapters::instance().lookup_by_typename(adaptor->getShortTypeStr()); types::InternalType* returnType; switch (adapter_index) { case view_scilab::Adapters::BLOCK_ADAPTER: returnType = set<view_scilab::BlockAdapter, model::Block>(adaptor, field, value); if (returnType == 0) { return types::Function::Error; } out.push_back(returnType); break; case view_scilab::Adapters::CPR_ADAPTER: returnType = set<view_scilab::CprAdapter, model::Diagram>(adaptor, field, value); if (returnType == 0) { return types::Function::Error; } out.push_back(returnType); break; case view_scilab::Adapters::DIAGRAM_ADAPTER: returnType = set<view_scilab::DiagramAdapter, model::Diagram>(adaptor, field, value); if (returnType == 0) { return types::Function::Error; } out.push_back(returnType); break; case view_scilab::Adapters::GRAPHIC_ADAPTER: returnType = set<view_scilab::GraphicsAdapter, model::Block>(adaptor, field, value); if (returnType == 0) { return types::Function::Error; } out.push_back(returnType); break; case view_scilab::Adapters::LINK_ADAPTER: returnType = set<view_scilab::LinkAdapter, model::Link>(adaptor, field, value); if (returnType == 0) { return types::Function::Error; } out.push_back(returnType); break; case view_scilab::Adapters::MODEL_ADAPTER: returnType = set<view_scilab::ModelAdapter, model::Block>(adaptor, field, value); if (returnType == 0) { return types::Function::Error; } out.push_back(returnType); break; case view_scilab::Adapters::PARAMS_ADAPTER: returnType = set<view_scilab::ParamsAdapter, model::Diagram>(adaptor, field, value); if (returnType == 0) { return types::Function::Error; } out.push_back(returnType); break; case view_scilab::Adapters::SCS_ADAPTER: returnType = set<view_scilab::ScsAdapter, model::Diagram>(adaptor, field, value); if (returnType == 0) { return types::Function::Error; } out.push_back(returnType); break; case view_scilab::Adapters::STATE_ADAPTER: returnType = set<view_scilab::StateAdapter, model::Diagram>(adaptor, field, value); if (returnType == 0) { return types::Function::Error; } out.push_back(returnType); break; case view_scilab::Adapters::TEXT_ADAPTER: returnType = set<view_scilab::TextAdapter, model::Annotation>(adaptor, field, value); if (returnType == 0) { return types::Function::Error; } out.push_back(returnType); break; default: Scierror(999, _("%s: Wrong value for input argument #%d: \"%ls\" type is not managed.\n"), funame.data(), 2, adaptor->getTypeStr().c_str()); return types::Function::Error; break; } return types::Function::OK; }
/*--------------------------------------------------------------------------*/ types::Function::ReturnValue sci_file_one_rhs(types::typed_list &in, int _iRetCount, types::typed_list &out) { if (in[0]->isDouble() == false || in[0]->getAs<types::Double>()->getSize() != 1) { Scierror(201, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "file", 1); return types::Function::Error; } types::Double* pD = in[0]->getAs<types::Double>(); int iID = static_cast<int>(pD->getReal()[0]); //check if double value is an integer to exclude decimal values if (static_cast<double>(iID) != pD->getReal()[0]) { Scierror(201, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "file", 1); return types::Function::Error; } types::File *pF = FileManager::getFile(iID); if (pF == NULL) { for (int i = 0 ; i < _iRetCount ; i++) { out.push_back(types::Double::Empty()); } return types::Function::OK; } out.push_back(new types::Double(iID)); if (_iRetCount > 1) /*type*/ { wchar_t* pstType = os_wcsdup(pF->getFileTypeAsString().c_str()); if (pstType != NULL) { types::String* pS = new types::String(pstType); out.push_back(pS); FREE(pstType); } } if (_iRetCount > 2) /*name*/ { wchar_t* pstName = os_wcsdup(pF->getFilename().c_str()); if (pstName != NULL) { types::String* pS = new types::String(pstName); out.push_back(pS); FREE(pstName); } } if (_iRetCount > 3) /* mod */ { if (pF->getFileType() == 1) { out.push_back(new types::Double((double)pF->getFileFortranMode())); } else // if(pF->getFileType() == 2) { out.push_back(new types::Double((double)pF->getFileModeAsInt())); } } if (_iRetCount > 4) /* swap */ { out.push_back(new types::Double(pF->getFileSwap())); } return types::Function::OK; }
types::Function::ReturnValue sci_interp2d(types::typed_list &in, int _iRetCount, types::typed_list &out) { // input types::Double* pDblXp = NULL; types::Double* pDblYp = NULL; types::Double* pDblX = NULL; types::Double* pDblY = NULL; types::Double* pDblC = NULL; // output types::Double* pDblZp = NULL; types::Double* pDblDzpdx = NULL; types::Double* pDblDzpdy = NULL; types::Double* pDblD2zdx2p = NULL; types::Double* pDblD2zdxyp = NULL; types::Double* pDblD2zdy2p = NULL; int iType = 8; // default C0 int sizeOfX = 0; int sizeOfXp = 0; int sizeOfY = 0; int sizeOfC = 0; // *** check the minimal number of input args. *** if (in.size() < 5 || in.size() > 6) { Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "interp2d", 5, 6); return types::Function::Error; } // *** check number of output args according the methode. *** if (_iRetCount > 6) { Scierror(78, _("%s: Wrong number of output argument(s): %d to %d expected.\n"), "interp2d", 1, 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"), "interp2d", 1); return types::Function::Error; } pDblXp = in[0]->getAs<types::Double>(); sizeOfXp = pDblXp->getSize(); if (pDblXp->isComplex()) { Scierror(999, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), "interp2d", 1); return types::Function::Error; } // yp if (in[1]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d : A matrix expected.\n"), "interp2d", 2); return types::Function::Error; } pDblYp = in[1]->getAs<types::Double>(); if (pDblXp->getRows() != pDblYp->getRows() || pDblXp->getCols() != pDblYp->getCols()) { Scierror(999, _("%s: Wrong size for input arguments #%d and #%d: Same size expected.\n"), "interp2d", 1, 2); return types::Function::Error; } if (pDblYp->isComplex()) { Scierror(999, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), "interp2d", 2); return types::Function::Error; } // x if (in[2]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d : A matrix expected.\n"), "interp2d", 3); return types::Function::Error; } pDblX = in[2]->getAs<types::Double>(); sizeOfX = pDblX->getSize(); if (pDblX->getRows() != 1 || pDblX->getSize() < 2) { Scierror(999, _("%s: Wrong size for input arguments #%d: A row vector of size at least 2 expected.\n"), "interp2d", 3); return types::Function::Error; } if (pDblX->isComplex()) { Scierror(999, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), "interp2d", 3); return types::Function::Error; } // y if (in[3]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d : A matrix expected.\n"), "interp2d", 4); return types::Function::Error; } pDblY = in[3]->getAs<types::Double>(); sizeOfY = pDblY->getSize(); if (pDblY->getRows() != 1 || pDblY->getSize() < 2) { Scierror(999, _("%s: Wrong size for input arguments #%d: A row vector of size at least 2 expected.\n"), "interp2d", 4); return types::Function::Error; } // c if (in[4]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d : A matrix expected.\n"), "interp2d", 5); return types::Function::Error; } pDblC = in[4]->getAs<types::Double>(); sizeOfC = 16 * (sizeOfX - 1) * (sizeOfY - 1); if (pDblC->getCols() != 1 || pDblC->getSize() != sizeOfC) { Scierror(999, _("%s: Wrong size for input arguments #%d: A colomn vector of size %d expected.\n"), "interp2d", 5, sizeOfC); return types::Function::Error; } // out mode if (in.size() == 6) { if (in[5]->isString() == false) { Scierror(999, _("%s: Wrong type for input argument #%d : A string expected.\n"), "interp2d", 6); return types::Function::Error; } wchar_t* wcsType = in[5]->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"natural") == 0) { iType = 1; } else if (wcscmp(wcsType, L"periodic") == 0) { iType = 3; } else if (wcscmp(wcsType, L"by_nan") == 0) { iType = 10; } else // undefined { Scierror(999, _("%s: Wrong values for input argument #%d : '%s' is a unknow '%s' type.\n"), "interp2d", 6, wcsType, "outmode"); return types::Function::Error; } } // *** Perform operation. *** pDblZp = new types::Double(pDblXp->getRows(), pDblXp->getCols()); if (_iRetCount == 1) { C2F(bicubicinterp)(pDblX->get(), pDblY->get(), pDblC->get(), &sizeOfX, &sizeOfY, pDblXp->get(), pDblYp->get(), pDblZp->get(), &sizeOfXp, &iType); } else // if(_iRetCount > 2) { pDblDzpdx = new types::Double(pDblXp->getRows(), pDblXp->getCols()); pDblDzpdy = new types::Double(pDblXp->getRows(), pDblXp->getCols()); if (_iRetCount == 3) { C2F(bicubicinterpwithgrad)(pDblX->get(), pDblY->get(), pDblC->get(), &sizeOfX, &sizeOfY, pDblXp->get(), pDblYp->get(), pDblZp->get(), pDblDzpdx->get(), pDblDzpdy->get(), &sizeOfXp, &iType); } else // == 6 { pDblD2zdx2p = new types::Double(pDblXp->getRows(), pDblXp->getCols()); pDblD2zdxyp = new types::Double(pDblXp->getRows(), pDblXp->getCols()); pDblD2zdy2p = new types::Double(pDblXp->getRows(), pDblXp->getCols()); C2F(bicubicinterpwithgradandhes)(pDblX->get(), pDblY->get(), pDblC->get(), &sizeOfX, &sizeOfY, pDblXp->get(), pDblYp->get(), pDblZp->get(), pDblDzpdx->get(), pDblDzpdy->get(), pDblD2zdx2p->get(), pDblD2zdxyp->get(), pDblD2zdy2p->get(), &sizeOfXp, &iType); } } // *** Return result in Scilab. *** switch (_iRetCount) { case 6 : out.insert(out.begin(), pDblD2zdy2p); case 5 : out.insert(out.begin(), pDblD2zdxyp); case 4 : out.insert(out.begin(), pDblD2zdx2p); case 3 : out.insert(out.begin(), pDblDzpdy); case 2 : out.insert(out.begin(), pDblDzpdx); default : break; } out.insert(out.begin(), pDblZp); return types::Function::OK; }
types::Function::ReturnValue sci_rand(types::typed_list &in, int _iRetCount, types::typed_list &out) { types::Double* pOut = NULL; static int siRandType = 0; static int siRandSave = 0; static int iForceInit = 0; int iSizeIn = (int)in.size(); if (iSizeIn == 0 || iSizeIn == -1) { //rand or rand() double dblRand = getNextRandValue(siRandType, &siRandSave, 0); out.push_back(new types::Double(dblRand)); return types::Function::OK; } if (in[0]->isString()) { //rand("xxx") types::String* pS = in[0]->getAs<types::String>(); if (pS->getSize() != 1) { Scierror(999, _("%s: Wrong size for input argument #%d: string expected.\n"), "rand", 1); return types::Function::Error; } wchar_t* pwstKey = pS->get(0); if (pwstKey[0] == g_pwstConfigInfo[0]) { //info if (iSizeIn > 1) { Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "rand", 1); return types::Function::Error; } if (siRandType == 0) { out.push_back(new types::String(g_pwstTypeUniform)); } else { out.push_back(new types::String(g_pwstTypeNormal)); } } else if (pwstKey[0] == g_pwstConfigSeed[0]) { //seed if (iSizeIn == 1) { //get out.push_back(new types::Double(siRandSave)); } else if (iSizeIn == 2) { if (in[1]->isDouble() == false || in[1]->getAs<types::Double>()->isScalar() == false) { Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "rand", 2); return types::Function::Error; } siRandSave = (int)std::max(in[1]->getAs<types::Double>()->get(0), double(0)); iForceInit = 1; } else { Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "rand", 2); return types::Function::Error; } } else { siRandType = setRandType(pwstKey[0]); } } else { int iRandSave = siRandType; if (in[iSizeIn - 1]->isString()) { //uniform ou normal types::String* pS = in[iSizeIn - 1]->getAs<types::String>(); if (pS->getSize() != 1) { Scierror(999, _("%s: Wrong size for input argument #%d: string expected.\n"), "rand", iSizeIn); return types::Function::Error; } //set randomize law iRandSave = siRandType; siRandType = setRandType(pS->get(0)[0]); iSizeIn--; } types::typed_list args; std::copy(in.begin(), in.begin() + iSizeIn, back_inserter(args)); int iDims = 0; int* piDims = NULL; bool alloc = false; bool ret = getDimsFromArguments(args, "rand", &iDims, &piDims, &alloc); if (ret == false) { switch (iDims) { case -1: Scierror(21, _("Invalid index.\n")); break; case 1: { //call overload return Overload::generateNameAndCall(L"rand", in, _iRetCount, out); } } return types::Function::Error; } //special case for complex unique complex argument bool complex = false; if (in.size() == 1 && in[0]->isGenericType()) { complex = in[0]->getAs<types::GenericType>()->isComplex(); } pOut = new types::Double(iDims, piDims, complex); if (alloc) { delete[] piDims; } double* pd = pOut->get(); for (int i = 0; i < pOut->getSize(); i++) { pd[i] = getNextRandValue(siRandType, &siRandSave, iForceInit); iForceInit = 0; } if (pOut->isComplex()) { double* pImg = pOut->getImg(); for (int i = 0; i < pOut->getSize(); i++) { pImg[i] = getNextRandValue(siRandType, &siRandSave, iForceInit); } } out.push_back(pOut); //retore previous law siRandType = iRandSave; } return types::Function::OK; }
/*--------------------------------------------------------------------------*/ types::Function::ReturnValue sci_prod(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) int* piDimsArray = NULL; if (in.size() < 1 || in.size() > 3) { Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "prod", 1, 3); return types::Function::Error; } if (_iRetCount > 1) { Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "prod", 1); return types::Function::Error; } bool isCopy = true; /***** get data *****/ switch (in[0]->getType()) { case types::InternalType::ScilabDouble: { pDblIn = in[0]->getAs<types::Double>(); isCopy = false; break; } case types::InternalType::ScilabBool: { pDblIn = getAsDouble(in[0]->getAs<types::Bool>()); iOuttype = 2; break; } case types::InternalType::ScilabPolynom: { pPolyIn = in[0]->getAs<types::Polynom>(); break; } case types::InternalType::ScilabInt8: { pDblIn = getAsDouble(in[0]->getAs<types::Int8>()); break; } case types::InternalType::ScilabInt16: { pDblIn = getAsDouble(in[0]->getAs<types::Int16>()); break; } case types::InternalType::ScilabInt32: { pDblIn = getAsDouble(in[0]->getAs<types::Int32>()); break; } case types::InternalType::ScilabInt64: { pDblIn = getAsDouble(in[0]->getAs<types::Int64>()); break; } case types::InternalType::ScilabUInt8: { pDblIn = getAsDouble(in[0]->getAs<types::UInt8>()); break; } case types::InternalType::ScilabUInt16: { pDblIn = getAsDouble(in[0]->getAs<types::UInt16>()); break; } case types::InternalType::ScilabUInt32: { pDblIn = getAsDouble(in[0]->getAs<types::UInt32>()); break; } case types::InternalType::ScilabUInt64: { pDblIn = getAsDouble(in[0]->getAs<types::UInt64>()); break; } default: { std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_prod"; return Overload::call(wstFuncName, in, _iRetCount, out); } } if (in.size() >= 2) { if (in[1]->isDouble()) { types::Double* pDbl = in[1]->getAs<types::Double>(); if (pDbl->isScalar() == false) { if (isCopy && pDblIn) { pDblIn->killMe(); } Scierror(999, _("%s: Wrong value for input argument #%d: A positive scalar expected.\n"), "prod", 2); return types::Function::Error; } iOrientation = static_cast<int>(pDbl->get(0)); if (iOrientation <= 0) { if (isCopy && pDblIn) { pDblIn->killMe(); } Scierror(999, _("%s: Wrong value for input argument #%d: A positive scalar expected.\n"), "prod", 2); return types::Function::Error; } } else if (in[1]->isString()) { types::String* pStr = in[1]->getAs<types::String>(); if (pStr->isScalar() == false) { if (isCopy && pDblIn) { pDblIn->killMe(); } Scierror(999, _("%s: Wrong size for input argument #%d: A scalar string expected.\n"), "prod", 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 (isCopy && pDblIn) { pDblIn->killMe(); } Scierror(999, _("%s: Wrong value for input argument #%d: Must be in the set {%s}.\n"), "prod", 2, pstrExpected); return types::Function::Error; } } else { if (isCopy && pDblIn) { pDblIn->killMe(); } Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix or a string expected.\n"), "prod", 2); return types::Function::Error; } } if (in.size() == 3) { if (in[2]->isString() == false) { if (isCopy && pDblIn) { pDblIn->killMe(); } Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), "prod", 3); return types::Function::Error; } types::String* pStr = in[2]->getAs<types::String>(); if (pStr->isScalar() == false) { if (isCopy && pDblIn) { pDblIn->killMe(); } Scierror(999, _("%s: Wrong size for input argument #%d: A scalar string expected.\n"), "prod", 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 (isCopy && pDblIn) { pDblIn->killMe(); } Scierror(999, _("%s: Wrong value for input argument #%d: %s or %s expected.\n"), "prod", 3, "\"native\"", "\"double\""); return types::Function::Error; } } /***** perform operation *****/ if (pDblIn) { if (pDblIn->isEmpty()) { if (iOrientation == 0) { pDblOut = new types::Double(1); out.push_back(pDblOut); } else { out.push_back(types::Double::Empty()); } if (isCopy) { delete pDblIn; pDblIn = NULL; } return types::Function::OK; } if (iOrientation > pDblIn->getDims()) { if (isCopy) { pDblOut = pDblIn; } else { pDblOut = pDblIn->clone()->getAs<types::Double>(); } } else { pDblOut = prod(pDblIn, iOrientation); if (isCopy) { delete pDblIn; pDblIn = NULL; } } } else if (pPolyIn) { iOuttype = 1; if (iOrientation > pPolyIn->getDims()) { pPolyOut = pPolyIn->clone()->getAs<types::Polynom>(); } else { pPolyOut = prod(pPolyIn, iOrientation); } } /***** set result *****/ if ((iOuttype == 1) && isCopy) { switch (in[0]->getType()) { case types::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 types::InternalType::ScilabPolynom: { out.push_back(pPolyOut); break; } case types::InternalType::ScilabInt8: { out.push_back(toInt<types::Int8>(pDblOut)); break; } case types::InternalType::ScilabInt16: { out.push_back(toInt<types::Int16>(pDblOut)); break; } case types::InternalType::ScilabInt32: { out.push_back(toInt<types::Int32>(pDblOut)); break; } case types::InternalType::ScilabInt64: { out.push_back(toInt<types::Int64>(pDblOut)); break; } case types::InternalType::ScilabUInt8: { out.push_back(toInt<types::UInt8>(pDblOut)); break; } case types::InternalType::ScilabUInt16: { out.push_back(toInt<types::UInt16>(pDblOut)); break; } case types::InternalType::ScilabUInt32: { out.push_back(toInt<types::UInt32>(pDblOut)); break; } case types::InternalType::ScilabUInt64: { out.push_back(toInt<types::UInt64>(pDblOut)); break; } } if (pDblOut) { pDblOut->killMe(); } } else { out.push_back(pDblOut); } return types::Function::OK; }
/*--------------------------------------------------------------------------*/ types::Function::ReturnValue sci_arl2_ius(types::typed_list &in, int _iRetCount, types::typed_list &out) { types::Double* pDblY = NULL; types::Polynom* pPolyY = NULL; types::Polynom* pPolyDen = NULL; types::Double* pDblErr = NULL; double* pdblY = NULL; double* pdblDen = NULL; int iOne = 1; int iVol1 = 0; int iN = 0; bool bAll = false; int iRankDen = 0; double dErrl2 = 0; int lunit = 6; C2F(arl2c).info = 0; if (in.size() < 3 || in.size() > 5) { Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "arl2_ius", 3, 5); return types::Function::Error; } if (_iRetCount != 1 && _iRetCount > 3) { Scierror(78, _("%s: Wrong number of output argument(s): %d or %d expected.\n"), "arl2_ius", 1, 3); return types::Function::Error; } /*** get inputs arguments ***/ // get Y if (in[0]->isDouble()) { pDblY = in[0]->getAs<types::Double>(); if (pDblY->isComplex()) { Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "arl2_ius", 1); return types::Function::Error; } iVol1 = pDblY->getSize(); pdblY = pDblY->get(); } else if (in[0]->isPoly()) { pPolyY = in[0]->getAs<types::Polynom>(); if (pPolyY->isScalar() == false) { Scierror(999, _("%s: Wrong size for input argument #%d: A single polynom expected.\n"), "arl2_ius", 1); return types::Function::Error; } if (pPolyY->isComplex()) { Scierror(999, _("%s: Wrong type for input argument #%d: A real polynom expected.\n"), "arl2_ius", 1); return types::Function::Error; } types::SinglePoly* pSPCoefY = pPolyY->get(0); iVol1 = pSPCoefY->getSize(); pdblY = pSPCoefY->get(); } else { Scierror(999, _("%s: Wrong type for input argument #%d: A Matrix or polynom expected.\n"), "arl2_ius", 1); return types::Function::Error; } // get den <= useless in case "all" but it was does like that. if (in[1]->isPoly() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: A polynom expected.\n"), "arl2_ius", 2); return types::Function::Error; } pPolyDen = in[1]->getAs<types::Polynom>(); if (pPolyDen->isScalar() == false) { Scierror(999, _("%s: Wrong size for input argument #%d: A single polynom expected.\n"), "arl2_ius", 2); return types::Function::Error; } if (pPolyDen->isComplex()) { Scierror(999, _("%s: Wrong value for input argument #%d: A real polynom expected.\n"), "arl2_ius", 2); return types::Function::Error; } pPolyDen->getRank(&iRankDen); pdblDen = pPolyDen->get(0)->get(); C2F(idegre)(pdblDen, &iRankDen, &iRankDen); int iSize = iRankDen + 1; double dblScal = 1.0 / pdblDen[iRankDen]; C2F(dscal)(&iSize, &dblScal, pdblDen, &iOne); // get n if (in[2]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "arl2_ius", 3); return types::Function::Error; } types::Double* pDblN = in[2]->getAs<types::Double>(); iN = (int)pDblN->get(0); if (iN < 1) { Scierror(999, _("%s: Wrong value for input argument #%d: More or equal to %d expected.\n"), "arl2_ius", 3, 1); return types::Function::Error; } if (iN < iRankDen) { Scierror(999, _("%s: Wrong value for input argument #%d: More than degree of input argument #%d expected.\n"), "arl2_ius", 3, 2); return types::Function::Error; } // get "all" and/or imp if (in.size() == 4) { if (in[3]->isString()) // get "all" { types::String* pStrAll = in[3]->getAs<types::String>(); if (pStrAll->isScalar() == false) { Scierror(999, _("%s: Wrong size for input argument #%d: A scalar string expected.\n"), "arl2_ius", 4); return types::Function::Error; } if (wcscmp(pStrAll->get(0), L"all") != 0) { Scierror(999, _("%s: Wrong value for input argument #%d: 'all' expected.\n"), "arl2_ius", 4); return types::Function::Error; } bAll = true; } else if (in[3]->isDouble()) // get imp { types::Double* pDblImp = in[3]->getAs<types::Double>(); C2F(arl2c).info = (int)pDblImp->get(0); if (C2F(arl2c).info < 0) { Scierror(999, _("%s: Wrong value for input argument #%d: Positive value expected.\n"), "arl2_ius", 4); return types::Function::Error; } } else { Scierror(999, _("%s: Wrong type for input argument #%d: A scalar or string expected.\n"), "arl2_ius", 4); return types::Function::Error; } } else if (in.size() == 5) { // get imp if (in[3]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "arl2_ius", 4); return types::Function::Error; } types::Double* pDblImp = in[3]->getAs<types::Double>(); C2F(arl2c).info = (int)pDblImp->get(0); if (C2F(arl2c).info < 0) { Scierror(999, _("%s: Wrong value for input argument #%d: Positive value expected.\n"), "arl2_ius", 4); return types::Function::Error; } // get "all" if (in[4]->isString() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), "arl2_ius", 5); return types::Function::Error; } types::String* pStrAll = in[4]->getAs<types::String>(); if (pStrAll->isScalar() == false) { Scierror(999, _("%s: Wrong size for input argument #%d: A scalar string expected.\n"), "arl2_ius", 5); return types::Function::Error; } if (wcscmp(pStrAll->get(0), L"all") != 0) { Scierror(999, _("%s: Wrong value for input argument #%d: 'all' expected.\n"), "arl2_ius", 5); return types::Function::Error; } bAll = true; } /*** perform operations ***/ int iNg = iVol1 - 1; if (bAll) { // look for "all" solutions int iNsol = 0; int iMxsol = 20; double* pdblDenTemp = new double[iMxsol * (iN + 1)]; int iWorkSize = 34 + 34 * iN + 7 * iNg + iN * iNg + iN * iN * (iNg + 2) + 4 * (iN + 1) * iMxsol; double* pdblWork = new double[iWorkSize]; iWorkSize = 29 + iN * iN + 4 * iN + 2 * iMxsol; int* piWork = new int[iWorkSize]; C2F(arl2a)(pdblY, &iVol1, pdblDenTemp, &iMxsol, &iNsol, &iN, &(C2F(arl2c).info), &(C2F(arl2c).ierr), &lunit, pdblWork, piWork); delete[] pdblWork; delete[] piWork; if (C2F(arl2c).ierr) { if (C2F(arl2c).ierr == 3) { Scierror(999, _("%s: Loop on two orders detected.\n"), "arl2a"); delete[] pdblDenTemp; return types::Function::Error; } else if (C2F(arl2c).ierr == 4) { Scierror(999, _("%s: Impossible to reach required order.\n"), "arl2a"); delete[] pdblDenTemp; return types::Function::Error; } else if (C2F(arl2c).ierr == 5) { Scierror(999, _("%s: Failure when looking for the intersection with domains bounds.\n"), "arl2a"); delete[] pdblDenTemp; return types::Function::Error; } else if (C2F(arl2c).ierr == 7) { Scierror(999, _("%s: Too many solutions found.\n"), "arl2a"); delete[] pdblDenTemp; return types::Function::Error; } } /*** retrun output arguments ***/ // retrun denominators double** pdblAllCoeff = new double*[iNsol]; int iRank = iN + 1; int* piRank = new int[iNsol]; for (int i = 0; i < iNsol; i++) { piRank[i] = iRank; } types::Polynom* pPolyDenOut = new types::Polynom(pPolyDen->getVariableName(), iNsol, 1, piRank); for (int i = 0; i < iNsol; i++) { double* pdblDenOut = pPolyDenOut->get(i)->get(); C2F(dcopy)(&iN, pdblDenTemp + i, &iMxsol, pdblDenOut, &iOne); pdblDenOut[iN] = 1; pdblAllCoeff[i] = pdblDenOut; } delete[] pdblDenTemp; out.push_back(pPolyDenOut); // retrun numerators if (_iRetCount > 1) { for (int i = 0; i < iNsol; i++) { piRank[i] = iN; } C2F(no2f).gnrm = sqrt(C2F(no2f).gnrm); types::Polynom* pPolyNumOut = new types::Polynom(pPolyDen->getVariableName(), iNsol, 1, piRank); for (int i = 0; i < iNsol; i++) { double* pdblNumOut = pPolyNumOut->get(i)->get(); double* pdblWork = new double[iN + iNg + 1]; C2F(lq)(&iN, pdblAllCoeff[i], pdblWork, pdblY, &iNg); C2F(dscal)(&iN, &(C2F(no2f).gnrm), pdblWork, &iOne); C2F(dcopy)(&iN, pdblWork, &iOne, pdblNumOut, &iOne); delete[] pdblWork; } out.push_back(pPolyNumOut); } // return error if (_iRetCount > 2) { pDblErr = new types::Double(iNsol, 1); double* pdblerr = pDblErr->get(); double* pdblWork = new double[iN + iNg + 1]; for (int i = 0; i < iNsol; i++) { pdblerr[i] = sqrt(C2F(phi)(pdblAllCoeff[i], &iN, pdblY, &iNg, pdblWork)) * C2F(no2f).gnrm; } delete[] pdblWork; out.push_back(pDblErr); } delete[] piRank; delete[] pdblAllCoeff; } else { // look for a solution int iSizeNum = std::max(iN, iRankDen); double* pdblNum = new double[iSizeNum]; int iWorkSize = 32 + 32 * iN + 7 * iNg + iN * iNg + iN * iN * (iNg + 2); double* pdblWork = new double[iWorkSize]; iWorkSize = 29 + iN * iN + 4 * iN; int* piWork = new int[iWorkSize]; int iSizeTemp = std::max(iRankDen, iN) + 1; double* pDblDenTemp = new double[iSizeTemp]; memset(pDblDenTemp, 0x00, iSizeTemp * sizeof(double)); C2F(dcopy)(&iSize, pdblDen, &iOne, pDblDenTemp, &iOne); C2F(arl2)(pdblY, &iVol1, pdblNum, pDblDenTemp, &iRankDen, &iN, &dErrl2, pdblWork, piWork, &(C2F(arl2c).info), &(C2F(arl2c).ierr), &lunit); delete[] pdblWork; delete[] piWork; if (C2F(arl2c).ierr != 0) { if (C2F(arl2c).ierr == 3) { sciprint(_("%s: Loop on two orders detected.\n"), "arl2"); } else if (C2F(arl2c).ierr == 4) { sciprint(_("%s: Impossible to reach required order.\n previous order computed solution returned.\n"), "arl2"); } else if (C2F(arl2c).ierr == 5) { sciprint(_("%s: Failure when looking for the intersection with domains boundaries.\n previous order computed solution returned.\n"), "arl2"); } else if (C2F(arl2c).ierr == 7) { Scierror(999, _("%s: too many solutions found\n"), "arl2"); delete[] pdblNum; delete[] pDblDenTemp; return types::Function::Error; } } /*** retrun output arguments ***/ // retrun denominator int iRank = iN + 1; types::Polynom* pPolyDenOut = new types::Polynom(pPolyDen->getVariableName(), 1, 1, &iRank); double* pdblDenOut = pPolyDenOut->get(0)->get(); C2F(dcopy)(&iRank, pDblDenTemp, &iOne, pdblDenOut, &iOne); out.push_back(pPolyDenOut); // retrun numerator if (_iRetCount > 1) { types::Polynom* pPolyNumOut = new types::Polynom(pPolyDen->getVariableName(), 1, 1, &iN); double* pdblNumOut = pPolyNumOut->get(0)->get(); C2F(dcopy)(&iN, pdblNum, &iOne, pdblNumOut, &iOne); out.push_back(pPolyNumOut); } // return error if (_iRetCount > 2) { out.push_back(new types::Double(dErrl2)); } delete[] pDblDenTemp; delete[] pdblNum; } return types::Function::OK; }
types::Function::ReturnValue sci_spec(types::typed_list &in, int _iRetCount, types::typed_list &out) { double* pDataA = NULL; double* pDataB = NULL; bool symmetric = FALSE; int iRet = 0; if (in.size() != 1 && in.size() != 2) { Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "spec", 1, 2); return types::Function::Error; } if (_iRetCount > 2 * in.size()) { Scierror(78, _("%s: Wrong number of output argument(s): %d to %d expected.\n"), "spec", 1, 2 * in.size()); return types::Function::Error; } if (in[0]->isDouble() == false) { std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_spec"; return Overload::call(wstFuncName, in, _iRetCount, out); } types::Double* in0 = in[0]->getAs<types::Double>(); if (in0->getCols() != in0->getRows()) { Scierror(20, _("%s: Wrong type for input argument #%d: Square matrix expected.\n"), "spec", 1); return types::Function::Error; } if (in0->getRows() == -1 || in0->getCols() == -1) // manage eye case { Scierror(271, _("%s: Size varying argument a*eye(), (arg %d) not allowed here.\n"), "spec", 1); return types::Function::Error; } if (in0->getCols() == 0 || in0->getRows() == 0) // size null { out.push_back(types::Double::Empty()); for (int i = 1; i < _iRetCount; i++) { out.push_back(types::Double::Empty()); } return types::Function::OK; } types::Double* pDblA = in0->clone()->getAs<types::Double>(); if (in.size() == 1) { types::Double* pDblEigenValues = NULL; types::Double* pDblEigenVectors = NULL; if (pDblA->isComplex()) { pDataA = (double*)oGetDoubleComplexFromPointer(pDblA->getReal(), pDblA->getImg(), pDblA->getSize()); if (!pDataA) { pDblA->killMe(); Scierror(999, _("%s: Cannot allocate more memory.\n"), "spec"); return types::Function::Error; } } else { pDataA = pDblA->getReal(); } int totalSize = pDblA->getSize(); if ((pDblA->isComplex() ? C2F(vfiniteComplex)(&totalSize, (doublecomplex*)pDataA) : C2F(vfinite)(&totalSize, pDataA)) == false) { if (pDblA->isComplex()) { vFreeDoubleComplexFromPointer((doublecomplex*)pDataA); } pDblA->killMe(); Scierror(264, _("%s: Wrong value for input argument %d: Must not contain NaN or Inf.\n"), "spec", 1); return types::Function::Error; } symmetric = isSymmetric(pDblA->getReal(), pDblA->getImg(), pDblA->isComplex(), pDblA->getRows(), pDblA->getCols()) == 1; int eigenValuesCols = (_iRetCount == 1) ? 1 : pDblA->getCols(); if (symmetric) { pDblEigenValues = new types::Double(pDblA->getCols(), eigenValuesCols); if (_iRetCount == 2) { pDblEigenVectors = new types::Double(pDblA->getCols(), pDblA->getCols(), pDblA->isComplex()); } } else { pDblEigenValues = new types::Double(pDblA->getCols(), eigenValuesCols, true); if (_iRetCount == 2) { pDblEigenVectors = new types::Double(pDblA->getCols(), pDblA->getCols(), true); } } if (pDblA->isComplex()) { if (symmetric) { iRet = iEigen1ComplexSymmetricM((doublecomplex*)pDataA, pDblA->getCols(), (_iRetCount == 2), pDblEigenValues->getReal()); if (iRet < 0) { vFreeDoubleComplexFromPointer((doublecomplex*)pDataA); pDblA->killMe(); Scierror(998, _("%s: On entry to ZGEEV parameter number 3 had an illegal value (lapack library problem).\n"), "spec", iRet); return types::Function::Error; } if (iRet > 0) { vFreeDoubleComplexFromPointer((doublecomplex*)pDataA); pDblA->killMe(); Scierror(24, _("%s: Convergence problem, %d off-diagonal elements of an intermediate tridiagonal form did not converge to zero.\n"), "spec", iRet); return types::Function::Error; } if (_iRetCount == 2) { vGetPointerFromDoubleComplex((doublecomplex*)pDataA, pDblA->getSize() , pDblEigenVectors->getReal(), pDblEigenVectors->getImg()); vFreeDoubleComplexFromPointer((doublecomplex*)pDataA); expandToDiagonalOfMatrix(pDblEigenValues->getReal(), pDblA->getCols()); out.push_back(pDblEigenVectors); } out.push_back(pDblEigenValues); } else // not symmetric { doublecomplex* pEigenValues = (doublecomplex*)MALLOC(pDblA->getCols() * sizeof(doublecomplex)); doublecomplex* pEigenVectors = pDblEigenVectors ? (doublecomplex*)MALLOC(sizeof(doublecomplex) * pDblA->getSize()) : NULL; iRet = iEigen1ComplexM((doublecomplex*)pDataA, pDblA->getCols(), pEigenValues, pEigenVectors); vFreeDoubleComplexFromPointer((doublecomplex*)pDataA); if (iRet < 0) { pDblA->killMe(); Scierror(998, _("%s: On entry to ZHEEV parameter number 3 had an illegal value (lapack library problem).\n"), "spec", iRet); return types::Function::Error; } if (iRet > 0) { pDblA->killMe(); Scierror(24, _("%s: The QR algorithm failed to compute all the eigenvalues, and no eigenvectors have been computed. Elements and %d+1:N of W contain eigenvalues which have converged.\n"), "spec", iRet); return types::Function::Error; } if (_iRetCount == 2) { expandZToDiagonalOfCMatrix(pEigenValues, pDblA->getCols(), pDblEigenValues->getReal(), pDblEigenValues->getImg()); vGetPointerFromDoubleComplex(pEigenVectors, pDblA->getSize(), pDblEigenVectors->getReal(), pDblEigenVectors->getImg()); FREE(pEigenVectors); out.push_back(pDblEigenVectors); } else { vGetPointerFromDoubleComplex(pEigenValues, pDblA->getCols(), pDblEigenValues->getReal(), pDblEigenValues->getImg()); } out.push_back(pDblEigenValues); FREE(pEigenValues); pDblA->killMe(); } } else // real { if (symmetric) { iRet = iEigen1RealSymmetricM(pDataA, pDblA->getCols(), (_iRetCount == 2), pDblEigenValues->getReal()); if (iRet < 0) { pDblA->killMe(); Scierror(998, _("%s: On entry to ZGEEV parameter number 3 had an illegal value (lapack library problem).\n"), "spec", iRet); return types::Function::Error; } if (iRet > 0) { pDblA->killMe(); Scierror(24, _("%s: Convergence problem, %d off-diagonal elements of an intermediate tridiagonal form did not converge to zero.\n"), "spec", iRet); return types::Function::Error; } if (_iRetCount == 2) { expandToDiagonalOfMatrix(pDblEigenValues->getReal(), pDblA->getCols()); out.push_back(pDblA); } else { pDblA->killMe(); } out.push_back(pDblEigenValues); } else // not symmetric { iRet = iEigen1RealM(pDataA, pDblA->getCols(), pDblEigenValues->getReal(), pDblEigenValues->getImg(), pDblEigenVectors ? pDblEigenVectors->getReal() : NULL, pDblEigenVectors ? pDblEigenVectors->getImg() : NULL); if (iRet < 0) { pDblA->killMe(); Scierror(998, _("%s: On entry to ZHEEV parameter number 3 had an illegal value (lapack library problem).\n"), "spec", iRet); return types::Function::Error; } if (iRet > 0) { pDblA->killMe(); Scierror(24, _("%s: The QR algorithm failed to compute all the eigenvalues, and no eigenvectors have been computed. Elements and %d+1:N of WR and WI contain eigenvalues which have converged.\n"), "spec", iRet); return types::Function::Error; } if (_iRetCount == 2) { expandToDiagonalOfMatrix(pDblEigenValues->getReal(), pDblA->getCols()); expandToDiagonalOfMatrix(pDblEigenValues->getImg(), pDblA->getCols()); out.push_back(pDblEigenVectors); } out.push_back(pDblEigenValues); pDblA->killMe(); } } return types::Function::OK; } if (in.size() == 2) { types::Double* pDblL = NULL; types::Double* pDblR = NULL; types::Double* pDblBeta = NULL; types::Double* pDblAlpha = NULL; doublecomplex* pL = NULL; doublecomplex* pR = NULL; doublecomplex* pBeta = NULL; doublecomplex* pAlpha = NULL; bool bIsComplex = false; if (in[1]->isDouble() == false) { std::wstring wstFuncName = L"%" + in[1]->getShortTypeStr() + L"_spec"; return Overload::call(wstFuncName, in, _iRetCount, out); } types::Double* in1 = in[1]->getAs<types::Double>(); if (in1->getCols() != in1->getRows()) { Scierror(20, _("%s: Wrong type for input argument #%d: Square matrix expected.\n"), "spec", 2); return types::Function::Error; } if (pDblA->getRows() != in1->getRows() && pDblA->getCols() != in1->getCols()) { pDblA->killMe(); Scierror(999, _("%s: Arguments %d and %d must have equal dimensions.\n"), "spec", 1, 2); return types::Function::Error; } //chekc if A and B are real complex or with imag part at 0 if (isNoZeroImag(pDblA) == false && isNoZeroImag(in1) == false) { //view A and B as real matrix bIsComplex = false; } else { bIsComplex = pDblA->isComplex() || in1->isComplex(); } types::Double* pDblB = in1->clone()->getAs<types::Double>(); if (bIsComplex) { if (pDblA->isComplex() == false) { pDblA->setComplex(true); } if (pDblB->isComplex() == false) { pDblB->setComplex(true); } pDataA = (double*)oGetDoubleComplexFromPointer(pDblA->getReal(), pDblA->getImg(), pDblA->getSize()); pDataB = (double*)oGetDoubleComplexFromPointer(pDblB->getReal(), pDblB->getImg(), pDblB->getSize()); if (!pDataA || !pDataB) { delete pDataA; delete pDataB; Scierror(999, _("%s: Cannot allocate more memory.\n"), "spec"); return types::Function::Error; } } else { pDataA = pDblA->getReal(); pDataB = pDblB->getReal(); } int totalSize = pDblA->getSize(); if ((pDblA->isComplex() ? C2F(vfiniteComplex)(&totalSize, (doublecomplex*)pDataA) : C2F(vfinite)(&totalSize, pDataA)) == false) { pDblA->killMe(); pDblB->killMe(); Scierror(264, _("%s: Wrong value for input argument %d: Must not contain NaN or Inf.\n"), "spec", 1); return types::Function::Error; } if ((pDblB->isComplex() ? C2F(vfiniteComplex)(&totalSize, (doublecomplex*)pDataB) : C2F(vfinite)(&totalSize, pDataB)) == false) { pDblA->killMe(); pDblB->killMe(); Scierror(264, _("%s: Wrong value for input argument %d: Must not contain NaN or Inf.\n"), "spec", 2); return types::Function::Error; } switch (_iRetCount) { case 4: { pDblL = new types::Double(pDblA->getRows(), pDblA->getCols(), true); if (bIsComplex) { pL = (doublecomplex*)MALLOC(pDblA->getSize() * sizeof(doublecomplex)); } } case 3: { pDblR = new types::Double(pDblA->getRows(), pDblA->getCols(), true); if (bIsComplex) { pR = (doublecomplex*)MALLOC(pDblA->getSize() * sizeof(doublecomplex)); } } case 2: { if (bIsComplex) { pBeta = (doublecomplex*)MALLOC(pDblA->getCols() * sizeof(doublecomplex)); } pDblBeta = new types::Double(pDblA->getCols(), 1, pBeta ? true : false); } default : // case 1: { if (bIsComplex) { pAlpha = (doublecomplex*)MALLOC(pDblA->getCols() * sizeof(doublecomplex)); } pDblAlpha = new types::Double(pDblA->getCols(), 1, true); } } if (bIsComplex) { iRet = iEigen2ComplexM((doublecomplex*)pDataA, (doublecomplex*)pDataB, pDblA->getCols(), pAlpha, pBeta, pR, pL); } else { iRet = iEigen2RealM( pDataA, pDataB, pDblA->getCols(), pDblAlpha->getReal(), pDblAlpha->getImg(), pDblBeta ? pDblBeta->getReal() : NULL, pDblR ? pDblR->getReal() : NULL, pDblR ? pDblR->getImg() : NULL, pDblL ? pDblL->getReal() : NULL, pDblL ? pDblL->getImg() : NULL); } if (iRet > 0) { sciprint(_("Warning :\n")); sciprint(_("Non convergence in the QZ algorithm.\n")); sciprint(_("The top %d x %d blocks may not be in generalized Schur form.\n"), iRet); } if (iRet < 0) { pDblA->killMe(); pDblB->killMe(); Scierror(998, _("%s: On entry to ZHEEV parameter number 3 had an illegal value (lapack library problem).\n"), "spec", iRet); return types::Function::Error; } if (iRet > 0) { if (bIsComplex) { if (iRet <= pDblA->getCols()) { Scierror(24, _("%s: The QZ iteration failed in DGGEV.\n"), "spec"); } else { if (iRet == pDblA->getCols() + 1) { Scierror(999, _("%s: Other than QZ iteration failed in DHGEQZ.\n"), "spec"); } if (iRet == pDblA->getCols() + 2) { Scierror(999, _("%s: Error return from DTGEVC.\n"), "spec"); } } } else { Scierror(24, _("%s: The QR algorithm failed to compute all the eigenvalues, and no eigenvectors have been computed. Elements and %d+1:N of W contain eigenvalues which have converged.\n"), "spec", iRet); } pDblA->killMe(); pDblB->killMe(); if (pDataA) { vFreeDoubleComplexFromPointer((doublecomplex*)pDataA); } if (pDataB) { vFreeDoubleComplexFromPointer((doublecomplex*)pDataB); } return types::Function::Error; } if (bIsComplex) { switch (_iRetCount) { case 4: vGetPointerFromDoubleComplex(pL, pDblA->getSize(), pDblL->getReal(), pDblL->getImg()); case 3: vGetPointerFromDoubleComplex(pR, pDblA->getSize(), pDblR->getReal(), pDblR->getImg()); case 2: vGetPointerFromDoubleComplex(pBeta, pDblA->getCols(), pDblBeta->getReal(), pDblBeta->getImg()); default : // case 1: vGetPointerFromDoubleComplex(pAlpha, pDblA->getCols(), pDblAlpha->getReal(), pDblAlpha->getImg()); } } switch (_iRetCount) { case 1: { out.push_back(pDblAlpha); break; } case 2: { out.push_back(pDblAlpha); out.push_back(pDblBeta); break; } case 3: { out.push_back(pDblAlpha); out.push_back(pDblBeta); out.push_back(pDblR); break; } case 4: { out.push_back(pDblAlpha); out.push_back(pDblBeta); out.push_back(pDblL); out.push_back(pDblR); } } if (pAlpha) { vFreeDoubleComplexFromPointer(pAlpha); } if (pBeta) { vFreeDoubleComplexFromPointer(pBeta); } if (pL) { vFreeDoubleComplexFromPointer(pL); } if (pR) { vFreeDoubleComplexFromPointer(pR); } if (bIsComplex && pDblB->isComplex()) { vFreeDoubleComplexFromPointer((doublecomplex*)pDataB); } pDblB->killMe(); } // if(in.size() == 2) if (pDblA->isComplex()) { vFreeDoubleComplexFromPointer((doublecomplex*)pDataA); } return types::Function::OK; }
types::Function::ReturnValue freqState(types::typed_list &in, int _iRetCount, types::typed_list &out) { types::Double* pDblA = NULL; types::Double* pDblB = NULL; types::Double* pDblC = NULL; types::Double* pDblD = NULL; types::Double* pDblF = NULL; double dZero = 0; int iRowsA = 0; int iColsB = 0; int iRowsC = 0; int iSizeF = 0; int iOne = 1; int iComplex = 0; int iSizeD = 0; int iSizeC = 0; int iSizeB = 0; int iSizeA = 0; double* pdblA = NULL; double* pdblB = NULL; double* pdblC = NULL; double* pdblD = NULL; double* pdblF = NULL; double* pdblFImg = NULL; /*** get inputs arguments ***/ int iNbInputArg = (int)in.size(); // get f if (in[iNbInputArg - 1]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "freq", iNbInputArg); return types::Function::Error; } pDblF = in[iNbInputArg - 1]->getAs<types::Double>(); pdblF = pDblF->get(); if (pDblF->isComplex()) { pdblFImg = pDblF->getImg(); iComplex = 1; } else { pdblFImg = &dZero; } if (iNbInputArg == 5) { //get D if (in[3]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "freq", 4); return types::Function::Error; } pDblD = in[3]->getAs<types::Double>(); if (pDblD->isComplex()) { Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "freq", 4); return types::Function::Error; } } // get C if (in[2]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "freq", 3); return types::Function::Error; } pDblC = in[2]->getAs<types::Double>(); if (pDblC->isComplex()) { Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "freq", 3); return types::Function::Error; } // get B if (in[1]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "freq", 2); return types::Function::Error; } pDblB = in[1]->getAs<types::Double>(); if (pDblB->isComplex()) { Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "freq", 2); return types::Function::Error; } // get A if (in[0]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "freq", 1); return types::Function::Error; } pDblA = in[0]->getAs<types::Double>(); if (pDblA->isComplex()) { Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "freq", 1); return types::Function::Error; } if (pDblA->getRows() != pDblA->getCols()) { Scierror(999, _("%s: Wrong size for input argument #%d: A square matrix expected.\n"), "freq", 1); return types::Function::Error; } iRowsA = pDblA->getRows(); iColsB = pDblB->getCols(); iRowsC = pDblC->getRows(); iSizeF = pDblF->getSize(); if (iRowsA != pDblB->getRows() || iRowsA != pDblC->getCols()) { Scierror(999, _("%s: Wrong size for argument: Incompatible dimensions.\n"), "ppol"); return types::Function::Error; } if (iNbInputArg == 5 && (pDblD->getRows() != pDblC->getRows() || pDblD->getCols() != pDblB->getCols())) { Scierror(999, _("%s: Wrong size for argument: Incompatible dimensions.\n"), "ppol"); return types::Function::Error; } /*** perform operations ***/ int iJob = 0; bool bFirst = true; double dRcond = 0; int* pdblW1 = new int[iRowsA]; double* pdblW = new double[2 * iRowsA * iRowsA + 2 * iRowsA]; double* pdblWgr = new double[iColsB * iSizeF * iRowsC]; double* pdblWgi = new double[iColsB * iSizeF * iRowsC]; if (iNbInputArg == 5) { iSizeD = pDblD->getSize(); pdblD = new double[iSizeD]; memcpy(pdblD, pDblD->get(), iSizeD * sizeof(double)); } iSizeC = pDblC->getSize(); pdblC = new double[iSizeC]; memcpy(pdblC, pDblC->get(), iSizeC * sizeof(double)); iSizeB = pDblB->getSize(); pdblB = new double[iSizeB]; memcpy(pdblB, pDblB->get(), iSizeB * sizeof(double)); iSizeA = pDblA->getSize(); pdblA = new double[iSizeA]; memcpy(pdblA, pDblA->get(), iSizeA * sizeof(double)); for (int i = 0; i < iSizeF; i++) { int ig = i * iColsB * iRowsC; C2F(dfrmg)( &iJob, &iRowsA, &iRowsA, &iRowsC, &iRowsC, &iColsB, &iRowsA, pdblA, pdblB, pdblC, pdblF, pdblFImg, pdblWgr + ig, pdblWgi + ig, &dRcond, pdblW, pdblW1); if (bFirst && dRcond + 1 == 1) { sciprint(_("Warning :\n")); sciprint(_("matrix is close to singular or badly scaled. rcond = %g\n"), dRcond); bFirst = false; } if (iNbInputArg == 5) { int iSize = iColsB * iRowsC; C2F(dadd)(&iSize, pdblD, &iOne, pdblWgr + ig, &iOne); } pdblF++; pdblFImg += iComplex; } delete[] pdblA; delete[] pdblB; delete[] pdblC; if (iNbInputArg == 5) { delete[] pdblD; } /*** retrun output arguments ***/ types::Double* pDblOut = new types::Double(iRowsC, iColsB * iSizeF, iComplex == 1); double* pdblOutReal = pDblOut->get(); double* pdblOutImg = pDblOut->getImg(); int iSizeOut = pDblOut->getSize(); C2F(dcopy)(&iSizeOut, pdblWgr, &iOne, pdblOutReal, &iOne); if (iComplex) { C2F(dcopy)(&iSizeOut, pdblWgi, &iOne, pdblOutImg, &iOne); } // free memory delete[] pdblW; delete[] pdblW1; delete[] pdblWgr; delete[] pdblWgi; out.push_back(pDblOut); return types::Function::OK; }
/*--------------------------------------------------------------------------*/ types::Function::ReturnValue sci_testAnalysis(types::typed_list &in, int _iRetCount, types::typed_list &out) { if (in.size() == 0) { Scierror(999, _("%s: Wrong number of input arguments: at least %d expected.\n"), "testAnalysis", 1); return types::Function::Error; } // check that arguments are a string unsigned int i = 1; Location loc; ast::exps_t * args = new ast::exps_t(); args->reserve(in.size() - 1); for (const auto arg : in) { if (!arg->isString() || arg->getAs<types::String>()->getSize() != 1) { delete args; Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), "testAnalysis", i); return types::Function::Error; } if (i > 1) { symbol::Symbol sym(arg->getAs<types::String>()->get(0)); args->emplace_back(new ast::SimpleVar(loc, sym)); } ++i; } symbol::Symbol sym(in[0]->getAs<types::String>()->get(0)); ast::SimpleVar * var = new ast::SimpleVar(loc, sym); ast::CallExp ce(loc, *var, *args); analysis::AnalysisVisitor analysis; ce.accept(analysis); //analysis.print_info(); analysis::TIType & t = analysis.getResult().getType(); types::Struct * pOut = new types::Struct(1, 1); pOut->addField(L"type"); pOut->get(0)->set(L"type", new types::String(analysis::TIType::toString(t.type).c_str())); pOut->addField(L"rows"); if (t.rows.isConstant()) { pOut->get(0)->set(L"rows", new types::Double(t.rows.getConstant())); } else { pOut->get(0)->set(L"rows", new types::Double(analysis::tools::NaN())); } pOut->addField(L"cols"); if (t.cols.isConstant()) { pOut->get(0)->set(L"cols", new types::Double(t.cols.getConstant())); } else { pOut->get(0)->set(L"cols", new types::Double(analysis::tools::NaN())); } out.push_back(pOut); //ast::DebugVisitor debugMe; //pExp->accept(debugMe); //ast::PrintVisitor printMe(std::wcout); //pExp->accept(printMe); return types::Function::OK; }
types::Function::ReturnValue freqRational(types::typed_list &in, int _iRetCount, types::typed_list &out) { int iRowNum = 0; int iColNum = 0; int iRowDen = 0; int iColDen = 0; int iSizeF = 0; int iOne = 1; int iComplex = 0; int iError = 0; double dZero = 0; double** pdblDen = NULL; double** pdblNum = NULL; double* pdblF = NULL; double* pdblFImg = NULL; double* pdblR = NULL; double* pdblI = NULL; int* piRankDen = NULL; int* piRankNum = NULL; /*** get inputs arguments ***/ // get f if (in[2]->isDouble() == false) { Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "freq", 3); return types::Function::Error; } types::Double* pDblF = in[2]->getAs<types::Double>(); iSizeF = pDblF->getSize(); pdblF = pDblF->get(); if (pDblF->isComplex()) { pdblFImg = pDblF->getImg(); iComplex = 1; } else { pdblFImg = &dZero; } try { // get DEN if (in[1]->isDouble()) { types::Double* pDblDen = in[1]->getAs<types::Double>(); double* pdbl = pDblDen->get(); if (pDblDen->isComplex()) { Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "freq", 2); return types::Function::Error; } iRowDen = pDblDen->getRows(); iColDen = pDblDen->getCols(); piRankDen = new int[pDblDen->getSize()]; memset(piRankDen, 0x00, pDblDen->getSize() * sizeof(int)); pdblDen = new double*[pDblDen->getSize()]; for (int i = 0; i < pDblDen->getSize(); i++) { pdblDen[i] = pdbl + i; } } else if (in[1]->isPoly()) { types::Polynom* pPolyDen = in[1]->getAs<types::Polynom>(); double dblEps = NumericConstants::eps; if (pPolyDen->isComplex()) { bool cplx = false; int iSize = pPolyDen->getSize(); for (int i = 0; i < iSize; i++) { types::SinglePoly *sp = pPolyDen->get(i); double *df = sp->getImg(); for (int j = 0 ; j < sp->getSize(); j++) { if (abs(df[j]) > dblEps) { cplx = true; break; } } } if (cplx) { Scierror(999, _("%s: Wrong type for input argument #%d: A real polynom expected.\n"), "freq", 2); return types::Function::Error; } } iRowDen = pPolyDen->getRows(); iColDen = pPolyDen->getCols(); piRankDen = new int[pPolyDen->getSize()]; pPolyDen->getRank(piRankDen); pdblDen = new double*[pPolyDen->getSize()]; for (int i = 0; i < pPolyDen->getSize(); i++) { pdblDen[i] = pPolyDen->get(i)->get(); } } else { Scierror(999, _("%s: Wrong type for input argument #%d: A matrix or polynom expected.\n"), "freq", 2); return types::Function::Error; } // get NUM if (in[0]->isDouble()) { types::Double* pDblNum = in[0]->getAs<types::Double>(); double* pdbl = pDblNum->get(); if (pDblNum->isComplex()) { Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "freq", 1); throw 1; } iRowNum = pDblNum->getRows(); iColNum = pDblNum->getCols(); piRankNum = new int[pDblNum->getSize()]; memset(piRankNum, 0x00, pDblNum->getSize() * sizeof(int)); pdblNum = new double*[pDblNum->getSize()]; for (int i = 0; i < pDblNum->getSize(); i++) { pdblNum[i] = pdbl + i; } } else if (in[0]->isPoly()) { types::Polynom* pPolyNum = in[0]->getAs<types::Polynom>(); double dblEps = NumericConstants::eps; if (pPolyNum->isComplex()) { bool cplx = false; int iSize = pPolyNum->getSize(); for (int i = 0; i < iSize; i++) { types::SinglePoly *sp = pPolyNum->get(i); double *df = sp->getImg(); for (int j = 0 ; j < sp->getSize(); j++) { if (abs(df[j]) > dblEps) { cplx = true; break; } } } if (cplx) { Scierror(999, _("%s: Wrong type for input argument #%d: A real polynom expected.\n"), "freq", 1); return types::Function::Error; } } iRowNum = pPolyNum->getRows(); iColNum = pPolyNum->getCols(); piRankNum = new int[pPolyNum->getSize()]; pPolyNum->getRank(piRankNum); pdblNum = new double*[pPolyNum->getSize()]; for (int i = 0; i < pPolyNum->getSize(); i++) { pdblNum[i] = pPolyNum->get(i)->get(); } } else { Scierror(999, _("%s: Wrong type for input argument #%d: A matrix or polynom expected.\n"), "freq", 1); return types::Function::Error; } if (iRowNum != iRowDen || iColNum != iColDen) { Scierror(60, _("%s: Wrong size for argument: Incompatible dimensions.\n"), "freq"); throw 1; } /*** perform operations ***/ double dVr = 0; double dVi = 0; double dUr = 0; double dUi = 0; int iSize = iRowDen * iColDen * iSizeF; pdblR = new double[iSize]; pdblI = new double[iSize]; double* pdblRTemp = pdblR; double* pdblITemp = pdblI; for (int i = 0; i < iSizeF; i++) { for (int j = 0; j < iRowDen * iColDen; j++) { C2F(horner)(pdblNum[j], piRankNum + j, pdblF, pdblFImg, &dVr, &dVi); C2F(horner)(pdblDen[j], piRankDen + j, pdblF, pdblFImg, &dUr, &dUi); if (dUr * dUr + dUi * dUi == 0) { Scierror(27, _("%s: Division by zero...\n"), "freq"); throw 1; } if (iComplex) { C2F(wdiv)(&dVr, &dVi, &dUr, &dUi, pdblRTemp, pdblITemp); } else { *pdblRTemp = dVr / dUr; } pdblRTemp++; pdblITemp++; } pdblF++; pdblFImg += iComplex; } /*** retrun output arguments ***/ types::Double* pDblOut = new types::Double(iRowDen, iColDen * iSizeF, iComplex == 1); double* pdblOut = pDblOut->get(); int iSizeOut = pDblOut->getSize(); C2F(dcopy)(&iSizeOut, pdblR, &iOne, pdblOut, &iOne); if (iComplex) { double* pdblOutImg = pDblOut->getImg(); C2F(dcopy)(&iSizeOut, pdblI, &iOne, pdblOutImg, &iOne); } out.push_back(pDblOut); } catch (int iErr) { iError = iErr; } // free memory delete[] piRankDen; delete[] pdblDen; if (pdblR) { delete[] pdblR; } if (pdblI) { delete[] pdblI; } if (piRankNum) { delete[] piRankNum; } if (pdblNum) { delete[] pdblNum; } if (iError) { return types::Function::Error; } return types::Function::OK; }