License Header change: Removed the LICENSE_END before beta
[scilab.git] / scilab / modules / arnoldi / sci_gateway / c / sci_dsaupd.c
1 /*
2  * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3  * Copyright (C) ????-2008 - INRIA
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 <math.h>
17 #include <string.h>
18 #include "api_scilab.h"
19 #include "core_math.h"
20 #include "gw_arnoldi.h"
21 #include "localization.h"
22 #include "Scierror.h"
23 /*--------------------------------------------------------------------------*/
24 extern int C2F(dsaupd)(int *ido, char *bmat, int *n, char *which, int *nev,
25                        double *tol, double *resid, int *ncv, double *v,
26                        int *ldv, int *iparam, int *ipntr, double *workd,
27                        double *workl, int *lworkl, int *info);
28 /*--------------------------------------------------------------------------*/
29 int sci_dsaupd(char *fname, void *pvApiCtx)
30 {
31     SciErr sciErr;
32
33     int* piAddrpIDO     = NULL;
34     int* pIDO           = NULL;
35     int* piAddrpBMAT    = NULL;
36     char* pBMAT         = NULL;
37     int* piAddrpN       = NULL;
38     int* pN             = NULL;
39     int* piAddrpWHICH   = NULL;
40     char* pWHICH        = NULL;
41     int* piAddrpNEV     = NULL;
42     int* pNEV           = NULL;
43     int* piAddrpTOL     = NULL;
44     double* pTOL        = NULL;
45     int* piAddrpRESID   = NULL;
46     double* pRESID      = NULL;
47     int* piAddrpNCV     = NULL;
48     int* pNCV           = NULL;
49     int* piAddrpV       = NULL;
50     double* pV          = NULL;
51     int* piAddrpIPARAM  = NULL;
52     int* pIPARAM        = NULL;
53     int* piAddrpIPNTR   = NULL;
54     int* pIPNTR         = NULL;
55     int* piAddrpWORKD   = NULL;
56     double* pWORKD      = NULL;
57     int* piAddrpWORKL   = NULL;
58     double* pWORKL      = NULL;
59     int* piAddrpINFO    = NULL;
60     int* pINFO          = NULL;
61
62     int IDO,   mIDO,   nIDO;
63     int mN,     nN;
64     int mNEV,   nNEV;
65     int mTOL,   nTOL;
66     int RESID, mRESID, nRESID;
67     int mNCV,   nNCV;
68     int V,     mV,     nV;
69     int IPARAM, mIPARAM, nIPARAM;
70     int IPNTR, mIPNTR, nIPNTR;
71     int WORKD, mWORKD, nWORKD;
72     int WORKL, mWORKL, nWORKL;
73     int INFO,  mINFO,  nINFO;
74
75     int minlhs = 1, minrhs = 14, maxlhs = 8, maxrhs = 14;
76     int LDV, LWORKL;
77     int sizeWORKL = 0;
78
79     /* [IDO,RESID,V,IPARAM,IPNTR,WORKD,WORKL,INFO]=dsaupd...
80        (ID0,BMAT,N,WHICH,NEV,TOL,RESID,NCV,V,IPARAM,IPNTR,WORKD,WORKL,INFO) */
81
82     CheckInputArgument(pvApiCtx, minrhs, maxrhs);
83     CheckOutputArgument(pvApiCtx, minlhs, maxlhs);
84
85     /*                                                  VARIABLE = NUMBER   */
86     sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrpIDO);
87     if (sciErr.iErr)
88     {
89         printError(&sciErr, 0);
90         return 1;
91     }
92
93     // Retrieve a matrix of double at position 1.
94     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpIDO, &mIDO, &nIDO, &pIDO);
95     if (sciErr.iErr)
96     {
97         printError(&sciErr, 0);
98         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
99         return 1;
100     }
101
102     IDO =  1;
103
104     sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddrpN);
105     if (sciErr.iErr)
106     {
107         printError(&sciErr, 0);
108         return 1;
109     }
110
111     // Retrieve a matrix of double at position 3.
112     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpN, &mN, &nN, &pN);
113     if (sciErr.iErr)
114     {
115         printError(&sciErr, 0);
116         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 3);
117         return 1;
118     }
119
120     sciErr = getVarAddressFromPosition(pvApiCtx, 5, &piAddrpNEV);
121     if (sciErr.iErr)
122     {
123         printError(&sciErr, 0);
124         return 1;
125     }
126
127     // Retrieve a matrix of double at position 5.
128     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpNEV, &mNEV, &nNEV, &pNEV);
129     if (sciErr.iErr)
130     {
131         printError(&sciErr, 0);
132         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 5);
133         return 1;
134     }
135
136     sciErr = getVarAddressFromPosition(pvApiCtx, 6, &piAddrpTOL);
137     if (sciErr.iErr)
138     {
139         printError(&sciErr, 0);
140         return 1;
141     }
142
143     // Retrieve a matrix of double at position 6.
144     sciErr = getMatrixOfDouble(pvApiCtx, piAddrpTOL, &mTOL, &nTOL, &pTOL);
145     if (sciErr.iErr)
146     {
147         printError(&sciErr, 0);
148         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 6);
149         return 1;
150     }
151
152     sciErr = getVarAddressFromPosition(pvApiCtx, 7, &piAddrpRESID);
153     if (sciErr.iErr)
154     {
155         printError(&sciErr, 0);
156         return 1;
157     }
158
159     // Retrieve a matrix of double at position 7.
160     sciErr = getMatrixOfDouble(pvApiCtx, piAddrpRESID, &mRESID, &nRESID, &pRESID);
161     if (sciErr.iErr)
162     {
163         printError(&sciErr, 0);
164         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 7);
165         return 1;
166     }
167
168     RESID =  7;
169     sciErr = getVarAddressFromPosition(pvApiCtx, 8, &piAddrpNCV);
170     if (sciErr.iErr)
171     {
172         printError(&sciErr, 0);
173         return 1;
174     }
175
176     // Retrieve a matrix of double at position 8.
177     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpNCV, &mNCV, &nNCV, &pNCV);
178     if (sciErr.iErr)
179     {
180         printError(&sciErr, 0);
181         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 8);
182         return 1;
183     }
184
185     sciErr = getVarAddressFromPosition(pvApiCtx, 9, &piAddrpV);
186     if (sciErr.iErr)
187     {
188         printError(&sciErr, 0);
189         return 1;
190     }
191
192     // Retrieve a matrix of double at position 9.
193     sciErr = getMatrixOfDouble(pvApiCtx, piAddrpV, &mV, &nV, &pV);
194     if (sciErr.iErr)
195     {
196         printError(&sciErr, 0);
197         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 9);
198         return 1;
199     }
200
201     V =  9;
202     sciErr = getVarAddressFromPosition(pvApiCtx, 10, &piAddrpIPARAM);
203     if (sciErr.iErr)
204     {
205         printError(&sciErr, 0);
206         return 1;
207     }
208
209     // Retrieve a matrix of double at position 10.
210     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpIPARAM, &mIPARAM, &nIPARAM, &pIPARAM);
211     if (sciErr.iErr)
212     {
213         printError(&sciErr, 0);
214         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 10);
215         return 1;
216     }
217
218     IPARAM = 10;
219     sciErr = getVarAddressFromPosition(pvApiCtx, 11, &piAddrpIPNTR);
220     if (sciErr.iErr)
221     {
222         printError(&sciErr, 0);
223         return 1;
224     }
225
226     // Retrieve a matrix of double at position 11.
227     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpIPNTR, &mIPNTR, &nIPNTR, &pIPNTR);
228     if (sciErr.iErr)
229     {
230         printError(&sciErr, 0);
231         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 11);
232         return 1;
233     }
234
235     IPNTR = 11;
236     sciErr = getVarAddressFromPosition(pvApiCtx, 12, &piAddrpWORKD);
237     if (sciErr.iErr)
238     {
239         printError(&sciErr, 0);
240         return 1;
241     }
242
243     // Retrieve a matrix of double at position 12.
244     sciErr = getMatrixOfDouble(pvApiCtx, piAddrpWORKD, &mWORKD, &nWORKD, &pWORKD);
245     if (sciErr.iErr)
246     {
247         printError(&sciErr, 0);
248         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 12);
249         return 1;
250     }
251
252     WORKD = 12;
253     sciErr = getVarAddressFromPosition(pvApiCtx, 13, &piAddrpWORKL);
254     if (sciErr.iErr)
255     {
256         printError(&sciErr, 0);
257         return 1;
258     }
259
260     // Retrieve a matrix of double at position 13.
261     sciErr = getMatrixOfDouble(pvApiCtx, piAddrpWORKL, &mWORKL, &nWORKL, &pWORKL);
262     if (sciErr.iErr)
263     {
264         printError(&sciErr, 0);
265         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 13);
266         return 1;
267     }
268
269     WORKL = 13;
270     sciErr = getVarAddressFromPosition(pvApiCtx, 14, &piAddrpINFO);
271     if (sciErr.iErr)
272     {
273         printError(&sciErr, 0);
274         return 1;
275     }
276
277     // Retrieve a matrix of double at position 14.
278     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpINFO, &mINFO, &nINFO, &pINFO);
279     if (sciErr.iErr)
280     {
281         printError(&sciErr, 0);
282         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 14);
283         return 1;
284     }
285
286     INFO = 14;
287
288     LWORKL = mWORKL * nWORKL;
289     LDV = Max(1, pN[0]);
290
291     /* Don't call dnaupd if ido == 99 */
292     if (pIDO[0] == 99)
293     {
294         Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname);
295         return 1;
296     }
297
298     /* Check some sizes */
299     if (mIPARAM*nIPARAM != 11)
300     {
301         Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPARAM", 11);
302         return 1;
303     }
304
305     if (mIPNTR*nIPNTR != 14)
306     {
307         Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPNTR", 14);
308         return 1;
309     }
310
311     if (mRESID*nRESID != pN[0])
312     {
313         Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "RESID", pN[0]);
314         return 1;
315     }
316
317     if ((mV != pN[0]) || (nV != pNCV[0]))
318     {
319         Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", pN[0], pNCV[0]);
320         return 1;
321     }
322
323     if (mWORKD * nWORKD < 3 * pN[0])
324     {
325         Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKD", 3 * pN[0]);
326         return 1;
327     }
328
329     sizeWORKL = pNCV[0] * pNCV[0] + 8 * pNCV[0];
330
331     if (mWORKL * nWORKL < sizeWORKL)
332     {
333         Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
334         return 1;
335     }
336
337     sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrpBMAT);
338     if (sciErr.iErr)
339     {
340         printError(&sciErr, 0);
341         return 1;
342     }
343
344     // Retrieve a matrix of double at position 2.
345     if (getAllocatedSingleString(pvApiCtx, piAddrpBMAT, &pBMAT))
346     {
347         Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
348         return 1;
349     }
350
351     sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddrpWHICH);
352     if (sciErr.iErr)
353     {
354         freeAllocatedSingleString(pBMAT);
355         printError(&sciErr, 0);
356         return 1;
357     }
358
359     // Retrieve a matrix of double at position 4.
360     if (getAllocatedSingleString(pvApiCtx, piAddrpWHICH, &pWHICH))
361     {
362         freeAllocatedSingleString(pBMAT);
363         Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 4);
364         return 1;
365     }
366
367
368     C2F(dsaupd)(pIDO, pBMAT, pN,
369                 pWHICH, pNEV, pTOL,
370                 pRESID, pNCV, pV, &LDV,
371                 pIPARAM, pIPNTR, pWORKD,
372                 pWORKL, &LWORKL, pINFO);
373
374     freeAllocatedSingleString(pBMAT);
375     freeAllocatedSingleString(pWHICH);
376
377     if (pINFO[0] < 0)
378     {
379         Scierror(998, _("%s: internal error, info=%d.\n"), fname, *pINFO);
380         return 0;
381     }
382
383     AssignOutputVariable(pvApiCtx, 1) = IDO;
384     AssignOutputVariable(pvApiCtx, 2) = RESID;
385     AssignOutputVariable(pvApiCtx, 3) = V;
386     AssignOutputVariable(pvApiCtx, 4) = IPARAM;
387     AssignOutputVariable(pvApiCtx, 5) = IPNTR;
388     AssignOutputVariable(pvApiCtx, 6) = WORKD;
389     AssignOutputVariable(pvApiCtx, 7) = WORKL;
390     AssignOutputVariable(pvApiCtx, 8) = INFO;
391
392     ReturnArguments(pvApiCtx);
393
394     return 0;
395 }
396 /*--------------------------------------------------------------------------*/