0d9f2839f575a80571392ff9a692854208f2cdde
[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
46     //get argument #1
47     if (in[0]->isDouble() == false)
48     {
49         Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), "ordmmd", 1);
50         return types::Function::Error;
51     }
52
53     types::Double* pdbl1 = in[0]->getAs<types::Double>();
54     pdbl1->convertToInteger();
55     int* pXADJ = (int*)pdbl1->get();
56
57     //get argument #2
58     if (in[1]->isDouble() == false)
59     {
60         Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), "ordmmd", 2);
61         return types::Function::Error;
62     }
63
64     types::Double* pdbl2 = in[1]->getAs<types::Double>();
65     pdbl2->convertToInteger();
66     int* pADJNCY = (int*)pdbl2->get();
67     //get argument #3
68     types::Double* pdbl3 = in[2]->getAs<types::Double>();
69     if (in[2]->isDouble() == false || pdbl3->getSize() != 1)
70     {
71         Scierror(999, _("%s: Wrong type for input argument #%d: An integer value expected.\n"), "ordmmd", 3);
72         return types::Function::Error;
73     }
74
75     int NEQNS = (int)pdbl3->get(0);
76     if (NEQNS != (pdbl1->getSize() - 1))
77     {
78
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     types::Double* pdbl4 = new types::Double(NEQNS, 1);
84     pdbl4->convertToInteger();
85
86     types::Double* pdbl5 = new types::Double(NEQNS, 1);
87     pdbl5->convertToInteger();
88
89     types::Double* pdbl6 = new types::Double(1, 1);
90     pdbl6->convertToInteger();
91
92     types::Double* pdbl7 = new types::Double(4 * NEQNS, 1);
93     pdbl7->convertToInteger();
94     int iSize = 4 * NEQNS;
95     int iFlag = 0;
96     C2F(ordmmd)(&NEQNS, (int*)pdbl1->get(), (int*)pdbl2->get(), (int*)pdbl5->get(),
97                 (int*)pdbl4->get(), &iSize, (int*)pdbl7->get(), (int*)pdbl6->get(), &iFlag);
98
99     if (iFlag)
100     {
101         Scierror(999, _("%s: insufficient working storage"), "ordmmd");
102         return types::Function::Error;
103     }
104
105     pdbl1->convertFromInteger();
106     pdbl2->convertFromInteger();
107     pdbl4->convertFromInteger();
108     pdbl5->convertFromInteger();
109     pdbl6->convertFromInteger();
110     pdbl7->convertFromInteger();
111     delete pdbl7;
112
113     out.push_back(pdbl4);
114     out.push_back(pdbl5);
115     out.push_back(pdbl6);
116
117     return types::Function::OK;
118 }
119