Example of chfact help page crashed Scilab
[scilab.git] / scilab / modules / sparse / sci_gateway / cpp / sci_ordmmd.cpp
1 /*
2 *  Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 *  Copyright (C) 2010-2010 - DIGITEO - Bernard HUGUENEY
4 *
5  * Copyright (C) 2012 - 2016 - Scilab Enterprises
6  *
7  * This file is hereby licensed under the terms of the GNU GPL v2.0,
8  * pursuant to article 5.3.4 of the CeCILL v.2.1.
9  * This file was originally licensed under the terms of the CeCILL v2.1,
10  * and continues to be available under such terms.
11  * For more information, see the COPYING file which you should have received
12  * along with this program.
13 *
14 */
15
16 #include <iostream>
17 #include "sparse_gw.hxx"
18 #include "function.hxx"
19 #include "sparse.hxx"
20
21 extern "C"
22 {
23 #include "charEncoding.h"
24 #include "Scierror.h"
25 #include "localization.h"
26 }
27
28 extern "C" int C2F(ordmmd)(int* neqns, int* xadj, int* adjncy, int* invp, int* perm,
29                            int* iwsiz, int* iwork, int* nofsub, int* iflag);
30
31 types::Function::ReturnValue sci_ordmmd(types::typed_list &in, int _iRetCount, types::typed_list &out)
32 {
33     if (in.size() != 3)
34     {
35         Scierror(999, _("%s: Wrong number of input argument(s): %d expected.\n"), "ordmmd", 3);
36         return types::Function::Error;
37     }
38
39     if (_iRetCount != 3)
40     {
41         Scierror(999, _("%s: Wrong number of output arguments: %d expected.\n"), "ordmmd", 3);
42         return types::Function::Error;
43     }
44
45     //get argument #1
46     if (in[0]->isDouble() == false)
47     {
48         Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), "ordmmd", 1);
49         return types::Function::Error;
50     }
51
52     types::Double* pdbl1 = in[0]->getAs<types::Double>()->clone();
53
54     //get argument #2
55     if (in[1]->isDouble() == false)
56     {
57         delete(pdbl1);
58         Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), "ordmmd", 2);
59         return types::Function::Error;
60     }
61
62     types::Double* pdbl2 = in[1]->getAs<types::Double>()->clone();
63
64     //get argument #3
65     types::Double* pdbl3 = in[2]->getAs<types::Double>();
66     if (in[2]->isDouble() == false || pdbl3->getSize() != 1)
67     {
68         delete pdbl1;
69         delete pdbl2;
70         Scierror(999, _("%s: Wrong type for input argument #%d: An integer value expected.\n"), "ordmmd", 3);
71         return types::Function::Error;
72     }
73
74     int NEQNS = (int)pdbl3->get(0);
75     if (NEQNS != (pdbl1->getSize() - 1))
76     {
77         delete pdbl1;
78         delete pdbl2;
79         Scierror(999, _(" The provided \"n\" does not correspond to the matrix defined by xadj and iadj\n"));
80         return types::Function::Error;
81     }
82
83     pdbl1->convertToInteger();
84     pdbl2->convertToInteger();
85
86     types::Double* pdbl4 = new types::Double(NEQNS, 1);
87     pdbl4->convertToInteger();
88
89     types::Double* pdbl5 = new types::Double(NEQNS, 1);
90     pdbl5->convertToInteger();
91
92     types::Double* pdbl6 = new types::Double(1, 1);
93     pdbl6->convertToInteger();
94
95     int* pdbl7 = new int[4 * NEQNS];
96
97     int iSize = 4 * NEQNS;
98     int iFlag = 0;
99
100     C2F(ordmmd)(&NEQNS, (int*)pdbl1->get(), (int*)pdbl2->get(), (int*)pdbl5->get(),
101                 (int*)pdbl4->get(), &iSize, pdbl7, (int*)pdbl6->get(), &iFlag);
102
103     if (iFlag)
104     {
105         delete pdbl1;
106         delete pdbl2;
107         delete pdbl4;
108         delete pdbl5;
109         delete pdbl6;
110         delete[] pdbl7;
111         Scierror(999, _("%s: insufficient working storage"), "ordmmd");
112         return types::Function::Error;
113     }
114
115     pdbl4->convertFromInteger();
116     pdbl5->convertFromInteger();
117     pdbl6->convertFromInteger();
118
119     out.push_back(pdbl4);
120     out.push_back(pdbl5);
121     out.push_back(pdbl6);
122
123     delete pdbl1;
124     delete pdbl2;
125     delete[] pdbl7;
126
127     return types::Function::OK;
128 }
129