linear_algebra plugged.
[scilab.git] / scilab / modules / linear_algebra / sci_gateway / cpp / sci_hess.cpp
1 /*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) 2009 - DIGITEO - Bernard HUGUENEY
4 * Copyright (C) 2011 - DIGITEO - Cedric DELAMARRE
5 *
6 * This file must be used under the terms of the CeCILL.
7 * This source file is licensed as described in the file COPYING, which
8 * you should have received as part of this distribution.  The terms
9 * are also available at
10 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
11 *
12 */
13 /*--------------------------------------------------------------------------*/
14
15 #include "linear_algebra_gw.hxx"
16 #include "function.hxx"
17 #include "double.hxx"
18 #include "overload.hxx"
19 #include "execvisitor.hxx"
20
21 extern "C"
22 {
23 #include "localization.h"
24 #include "Scierror.h"
25 #include "hess.h"
26 }
27 /*--------------------------------------------------------------------------*/
28
29 types::Function::ReturnValue sci_hess(types::typed_list &in, int _iRetCount, types::typed_list &out)
30 {
31     types::Double* pDbl     = NULL;
32     types::Double* pDblH    = NULL;
33     double* pdH             = NULL;
34     double* pData           = NULL;
35
36     if(in.size() != 1)
37     {
38         ScierrorW(77, _W("%ls: Wrong number of input argument(s): %d expected.\n"), L"hess", 1);
39         return types::Function::Error;
40     }
41
42     if(_iRetCount > 2)
43     {
44         ScierrorW(78, _W("%ls: Wrong number of output argument(s): %d to %d expected.\n"), L"hess", 1, 2);
45         return types::Function::Error;
46     }
47
48     if((in[0]->isDouble() == false))
49     {
50         std::wstring wstFuncName = L"%"  + in[0]->getShortTypeStr() + L"_hess";
51         return Overload::call(wstFuncName, in, _iRetCount, out, new ExecVisitor());
52     }
53
54     pDbl = in[0]->getAs<types::Double>()->clone()->getAs<types::Double>();
55
56     if(pDbl->getRows() != pDbl->getCols())
57     {
58         ScierrorW(20, _W("%ls: Wrong type for argument %d: Square matrix expected.\n"), L"hess", 1);
59         return types::Function::Error;
60     }
61
62     if((pDbl->getCols() == 0) || (pDbl->getRows() == 0))
63     {
64         out.push_back(types::Double::Empty());
65         if(_iRetCount == 2)
66         {
67             out.push_back(types::Double::Empty());
68         }
69         return types::Function::OK;
70     }
71
72     if(pDbl->getCols() == -1)
73     {
74         types::Double* pDblEyeMatrix = new types::Double(-1, -1);
75         out.push_back(pDblEyeMatrix);
76         return types::Function::Error;
77     }
78
79     if(pDbl->isComplex())
80     {
81         pData = (double *)oGetDoubleComplexFromPointer(pDbl->getReal(), pDbl->getImg(), pDbl->getSize());
82         if(!pData)
83         {
84             ScierrorW(999,_W("%ls: Cannot allocate more memory.\n"),L"hess");
85             return types::Function::Error;
86         }
87     }
88     else
89     {
90         pData = pDbl->getReal();
91     }
92
93     if(_iRetCount == 2)
94     {
95         pDblH = new types::Double(pDbl->getRows(), pDbl->getCols(), pDbl->isComplex());
96         if(pDbl->isComplex())
97         {
98             pdH = (double*)MALLOC(pDblH->getSize() * sizeof(doublecomplex));
99             if(!pdH)
100             {
101                 ScierrorW(999,_W("%ls: Cannot allocate more memory.\n"),L"hess");
102                 return types::Function::Error;
103             }
104         }
105         else
106         {
107             pdH = pDblH->getReal();
108         }
109     }
110
111     int iRet = iHessM(pData, pDbl->getCols(), pDbl->isComplex(), pdH);
112     if(iRet != 0)
113     {
114             ScierrorW(999, _W("%ls: LAPACK error n°%d.\n"), L"hess",iRet);
115         return types::Function::Error;
116     }
117
118     if(pDbl->isComplex())
119     {
120         vGetPointerFromDoubleComplex((doublecomplex*)(pData), pDbl->getSize(), pDbl->getReal(), pDbl->getImg());
121                 vFreeDoubleComplexFromPointer((doublecomplex*)pData);
122
123         if(_iRetCount == 2)
124         {
125             vGetPointerFromDoubleComplex((doublecomplex*)(pdH), pDblH->getSize(), pDblH->getReal(), pDblH->getImg());
126                 vFreeDoubleComplexFromPointer((doublecomplex*)pdH);
127         }
128     }
129
130     if(_iRetCount == 1)
131     {
132         out.push_back(pDbl);
133     }
134     else
135     {
136         out.push_back(pDblH);
137         out.push_back(pDbl);
138     }
139
140     return types::Function::OK;
141 }
142 /*--------------------------------------------------------------------------*/
143