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;
}
Пример #2
0
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;
}
Пример #3
0
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;
}
Пример #4
0
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;
}
Пример #5
0
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;
}
Пример #6
0
/*--------------------------------------------------------------------------*/
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;
}
Пример #7
0
/*--------------------------------------------------------------------------*/
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;
}
Пример #8
0
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;
}
Пример #9
0
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;
}
Пример #10
0
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;
}
Пример #11
0
/*--------------------------------------------------------------------------*/
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;
}
Пример #12
0
/*--------------------------------------------------------------------------*/
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;
}
Пример #13
0
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;
}
Пример #14
0
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;
}
Пример #15
0
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;
}
Пример #16
0
/*--------------------------------------------------------------------------*/
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;
}
Пример #17
0
/*--------------------------------------------------------------------------*/
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;
}
Пример #18
0
/*--------------------------------------------------------------------------*/
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;
}
Пример #19
0
/*--------------------------------------------------------------------------*/
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;
}
Пример #20
0
/*--------------------------------------------------------------------------*/
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;
}
Пример #22
0
/*--------------------------------------------------------------------------*/
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;
}
Пример #23
0
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;
}
Пример #24
0
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;
}
Пример #25
0
/*--------------------------------------------------------------------------*/
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;
}
Пример #26
0
/*--------------------------------------------------------------------------*/
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;
}
Пример #27
0
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;
}
Пример #28
0
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;
}
Пример #29
0
/*--------------------------------------------------------------------------*/
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;
}
Пример #30
0
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;
}