0db9a672ba99f8c04e4f1018281c3c30a41a1183
[scilab.git] / scilab / modules / arnoldi / sci_gateway / c / sci_dseupd.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(dseupd)(int *rvec, char *howmny, int *select, double *d,
25                        double *z, int *ldz, double *sigma, char *bmat,
26                        int *n, char *which, int *nev , double *tol,
27                        double *resid, int *ncv, double *v , int *ldv,
28                        int *iparam, int *ipntr, double *workd, double *workl,
29                        int *lworkl, int *info, unsigned long rvec_length,
30                        unsigned long howmany_length,
31                        unsigned long bmat_length, unsigned long which_len);
32 /*--------------------------------------------------------------------------*/
33 int sci_dseupd(char *fname, void *pvApiCtx)
34 {
35     SciErr sciErr;
36
37     int* piAddrpRVEC    = NULL;
38     int* pRVEC          = NULL;
39     int* piAddrpHOWMANY = NULL;
40     char* pHOWMANY      = NULL;
41     int* piAddrpSELECT  = NULL;
42     int* pSELECT        = NULL;
43     int* piAddrpD       = NULL;
44     double* pD          = NULL;
45     int* piAddrpZ       = NULL;
46     double* pZ          = NULL;
47     int* piAddrpSIGMA   = NULL;
48     double* pSIGMA      = NULL;
49     int* piAddrpBMAT    = NULL;
50     char* pBMAT         = NULL;
51     int* piAddrpN       = NULL;
52     int* pN             = NULL;
53     int* piAddrpWHICH   = NULL;
54     char* pWHICH        = NULL;
55     int* piAddrpNEV     = NULL;
56     int* pNEV           = NULL;
57     int* piAddrpTOL     = NULL;
58     double* pTOL        = NULL;
59     int* piAddrpRESID   = NULL;
60     double* pRESID      = NULL;
61     int* piAddrpNCV     = NULL;
62     int* pNCV           = NULL;
63     int* piAddrpV       = NULL;
64     double* pV          = NULL;
65     int* piAddrpIPARAM  = NULL;
66     int* pIPARAM        = NULL;
67     int* piAddrpIPNTR   = NULL;
68     int* pIPNTR         = NULL;
69     int* piAddrpWORKD   = NULL;
70     double* pWORKD      = NULL;
71     int* piAddrpWORKL   = NULL;
72     double* pWORKL      = NULL;
73     int* piAddrpINFO    = NULL;
74     int* pINFO          = NULL;
75
76     int mRVEC,     nRVEC;
77     int mSELECT,   nSELECT;
78     int D,        mD,        nD;
79     int Z,        mZ,        nZ;
80     int mSIGMA,    nSIGMA;
81     int mN,        nN;
82     int mNEV,      nNEV;
83     int mTOL,      nTOL;
84     int RESID,    mRESID,    nRESID;
85     int mNCV,      nNCV;
86     int V,        mV,        nV;
87     int IPARAM,   mIPARAM,   nIPARAM;
88     int IPNTR,    mIPNTR,    nIPNTR;
89     int WORKD,    mWORKD,    nWORKD;
90     int WORKL,    mWORKL,    nWORKL;
91     int INFO,     mINFO,     nINFO;
92
93     int minlhs = 1, minrhs = 19, maxlhs = 9, maxrhs = 19;
94     int LDZ, LDV, LWORKL;
95     int sizeWORKL = 0;
96
97     /* [D,Z,RESID,V,IPARAM,IPNTR,WORKD,WORKL,INFO]=dseupd...
98        (RVEC,HOWMANY,SELECT,D,Z,SIGMA,BMAT,N,WHICH,NEV,TOL,RESID,NCV,V,IPARAM,IPNTR,WORKD,WORKL,INFO) */
99
100     CheckInputArgument(pvApiCtx, minrhs, maxrhs);
101     CheckOutputArgument(pvApiCtx, minlhs, maxlhs);
102
103     /*                                                  VARIABLE = NUMBER   */
104     sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrpRVEC);
105     if (sciErr.iErr)
106     {
107         printError(&sciErr, 0);
108         return 1;
109     }
110
111     // Retrieve a matrix of double at position 1.
112     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpRVEC, &mRVEC, &nRVEC, &pRVEC);
113     if (sciErr.iErr)
114     {
115         printError(&sciErr, 0);
116         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 1);
117         return 1;
118     }
119
120     sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddrpSELECT);
121     if (sciErr.iErr)
122     {
123         printError(&sciErr, 0);
124         return 1;
125     }
126
127     // Retrieve a matrix of double at position 3.
128     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpSELECT, &mSELECT, &nSELECT, &pSELECT);
129     if (sciErr.iErr)
130     {
131         printError(&sciErr, 0);
132         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 3);
133         return 1;
134     }
135
136     sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddrpD);
137     if (sciErr.iErr)
138     {
139         printError(&sciErr, 0);
140         return 1;
141     }
142
143     // Retrieve a matrix of double at position 4.
144     sciErr = getMatrixOfDouble(pvApiCtx, piAddrpD, &mD, &nD, &pD);
145     if (sciErr.iErr)
146     {
147         printError(&sciErr, 0);
148         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 4);
149         return 1;
150     }
151
152     D =  4;
153     sciErr = getVarAddressFromPosition(pvApiCtx, 5, &piAddrpZ);
154     if (sciErr.iErr)
155     {
156         printError(&sciErr, 0);
157         return 1;
158     }
159
160     // Retrieve a matrix of double at position 5.
161     sciErr = getMatrixOfDouble(pvApiCtx, piAddrpZ, &mZ, &nZ, &pZ);
162     if (sciErr.iErr)
163     {
164         printError(&sciErr, 0);
165         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 5);
166         return 1;
167     }
168
169     Z =  5;
170     sciErr = getVarAddressFromPosition(pvApiCtx, 6, &piAddrpSIGMA);
171     if (sciErr.iErr)
172     {
173         printError(&sciErr, 0);
174         return 1;
175     }
176
177     // Retrieve a matrix of double at position 6.
178     sciErr = getMatrixOfDouble(pvApiCtx, piAddrpSIGMA, &mSIGMA, &nSIGMA, &pSIGMA);
179     if (sciErr.iErr)
180     {
181         printError(&sciErr, 0);
182         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 6);
183         return 1;
184     }
185
186     sciErr = getVarAddressFromPosition(pvApiCtx, 8, &piAddrpN);
187     if (sciErr.iErr)
188     {
189         printError(&sciErr, 0);
190         return 1;
191     }
192
193     // Retrieve a matrix of double at position 8.
194     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpN, &mN, &nN, &pN);
195     if (sciErr.iErr)
196     {
197         printError(&sciErr, 0);
198         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 8);
199         return 1;
200     }
201
202     sciErr = getVarAddressFromPosition(pvApiCtx, 10, &piAddrpNEV);
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, piAddrpNEV, &mNEV, &nNEV, &pNEV);
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     sciErr = getVarAddressFromPosition(pvApiCtx, 11, &piAddrpTOL);
219     if (sciErr.iErr)
220     {
221         printError(&sciErr, 0);
222         return 1;
223     }
224
225     // Retrieve a matrix of double at position 11.
226     sciErr = getMatrixOfDouble(pvApiCtx, piAddrpTOL, &mTOL, &nTOL, &pTOL);
227     if (sciErr.iErr)
228     {
229         printError(&sciErr, 0);
230         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 11);
231         return 1;
232     }
233
234     sciErr = getVarAddressFromPosition(pvApiCtx, 12, &piAddrpRESID);
235     if (sciErr.iErr)
236     {
237         printError(&sciErr, 0);
238         return 1;
239     }
240
241     // Retrieve a matrix of double at position 12.
242     sciErr = getMatrixOfDouble(pvApiCtx, piAddrpRESID, &mRESID, &nRESID, &pRESID);
243     if (sciErr.iErr)
244     {
245         printError(&sciErr, 0);
246         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 12);
247         return 1;
248     }
249
250     RESID = 12;
251     sciErr = getVarAddressFromPosition(pvApiCtx, 13, &piAddrpNCV);
252     if (sciErr.iErr)
253     {
254         printError(&sciErr, 0);
255         return 1;
256     }
257
258     // Retrieve a matrix of double at position 13.
259     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpNCV, &mNCV, &nNCV, &pNCV);
260     if (sciErr.iErr)
261     {
262         printError(&sciErr, 0);
263         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 13);
264         return 1;
265     }
266
267     sciErr = getVarAddressFromPosition(pvApiCtx, 14, &piAddrpV);
268     if (sciErr.iErr)
269     {
270         printError(&sciErr, 0);
271         return 1;
272     }
273
274     // Retrieve a matrix of double at position 14.
275     sciErr = getMatrixOfDouble(pvApiCtx, piAddrpV, &mV, &nV, &pV);
276     if (sciErr.iErr)
277     {
278         printError(&sciErr, 0);
279         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 14);
280         return 1;
281     }
282
283     V = 14;
284     sciErr = getVarAddressFromPosition(pvApiCtx, 15, &piAddrpIPARAM);
285     if (sciErr.iErr)
286     {
287         printError(&sciErr, 0);
288         return 1;
289     }
290
291     // Retrieve a matrix of double at position 15.
292     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpIPARAM, &mIPARAM, &nIPARAM, &pIPARAM);
293     if (sciErr.iErr)
294     {
295         printError(&sciErr, 0);
296         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 15);
297         return 1;
298     }
299
300     IPARAM = 15;
301     sciErr = getVarAddressFromPosition(pvApiCtx, 16, &piAddrpIPNTR);
302     if (sciErr.iErr)
303     {
304         printError(&sciErr, 0);
305         return 1;
306     }
307
308     // Retrieve a matrix of double at position 16.
309     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpIPNTR, &mIPNTR, &nIPNTR, &pIPNTR);
310     if (sciErr.iErr)
311     {
312         printError(&sciErr, 0);
313         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 16);
314         return 1;
315     }
316
317     IPNTR = 16;
318     sciErr = getVarAddressFromPosition(pvApiCtx, 17, &piAddrpWORKD);
319     if (sciErr.iErr)
320     {
321         printError(&sciErr, 0);
322         return 1;
323     }
324
325     // Retrieve a matrix of double at position 17.
326     sciErr = getMatrixOfDouble(pvApiCtx, piAddrpWORKD, &mWORKD, &nWORKD, &pWORKD);
327     if (sciErr.iErr)
328     {
329         printError(&sciErr, 0);
330         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 17);
331         return 1;
332     }
333
334     WORKD = 17;
335     sciErr = getVarAddressFromPosition(pvApiCtx, 18, &piAddrpWORKL);
336     if (sciErr.iErr)
337     {
338         printError(&sciErr, 0);
339         return 1;
340     }
341
342     // Retrieve a matrix of double at position 18.
343     sciErr = getMatrixOfDouble(pvApiCtx, piAddrpWORKL, &mWORKL, &nWORKL, &pWORKL);
344     if (sciErr.iErr)
345     {
346         printError(&sciErr, 0);
347         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 18);
348         return 1;
349     }
350
351     WORKL = 18;
352     sciErr = getVarAddressFromPosition(pvApiCtx, 19, &piAddrpINFO);
353     if (sciErr.iErr)
354     {
355         printError(&sciErr, 0);
356         return 1;
357     }
358
359     // Retrieve a matrix of double at position 19.
360     sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddrpINFO, &mINFO, &nINFO, &pINFO);
361     if (sciErr.iErr)
362     {
363         printError(&sciErr, 0);
364         Scierror(202, _("%s: Wrong type for argument #%d: A real expected.\n"), fname, 19);
365         return 1;
366     }
367
368     INFO = 19;
369
370     LWORKL = mWORKL * nWORKL;
371     LDV = Max(1, pN[0]);
372     LDZ = LDV;
373
374     /* Check some sizes */
375     if (mIPARAM * nIPARAM != 11)
376     {
377         Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPARAM", 11);
378         return 1;
379     }
380
381     if (mIPNTR * nIPNTR != 14)
382     {
383         Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "IPNTR", 14);
384         return 1;
385     }
386
387     if (mRESID * nRESID != pN[0])
388     {
389         Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "RESID", pN[0]);
390         return 1;
391     }
392
393     if (mWORKD * nWORKD < 3 * pN[0])
394     {
395         Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKD", 3 * pN[0]);
396         return 1;
397     }
398
399     if (mSELECT * nSELECT != pNCV[0])
400     {
401         Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "SELECT", pNCV[0]);
402         return 1;
403     }
404
405     if (mD * nD != (pNEV[0]))
406     {
407         Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "D", pNEV[0]);
408         return 1;
409     }
410
411     if ((mZ != pN[0]) || (nZ != pNEV[0]))
412     {
413         Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "Z", pN[0], pNEV[0]);
414         return 1;
415     }
416
417     if ((mV != pN[0]) || (nV != pNCV[0]))
418     {
419         Scierror(999, _("%s: Wrong size for input argument %s: A matrix of size %dx%d expected.\n"), fname, "V", pN[0], pNCV[0]);
420         return 1;
421     }
422
423     sizeWORKL = pNCV[0] * pNCV[0] + 8 * pNCV[0];
424
425     if ((mWORKL * nWORKL < sizeWORKL))
426     {
427         Scierror(999, _("%s: Wrong size for input argument %s: An array of size %d expected.\n"), fname, "WORKL", sizeWORKL);
428         return 1;
429     }
430
431
432     sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrpHOWMANY);
433     if (sciErr.iErr)
434     {
435         printError(&sciErr, 0);
436         return 1;
437     }
438
439     // Retrieve a matrix of double at position 2.
440     if (getAllocatedSingleString(pvApiCtx, piAddrpHOWMANY, &pHOWMANY))
441     {
442         freeAllocatedSingleString(pHOWMANY);
443         Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 2);
444         return 1;
445     }
446
447     sciErr = getVarAddressFromPosition(pvApiCtx, 7, &piAddrpBMAT);
448     if (sciErr.iErr)
449     {
450         freeAllocatedSingleString(pHOWMANY);
451         printError(&sciErr, 0);
452         return 1;
453     }
454
455     // Retrieve a matrix of double at position 7.
456     if (getAllocatedSingleString(pvApiCtx, piAddrpBMAT, &pBMAT))
457     {
458         freeAllocatedSingleString(pBMAT);
459         freeAllocatedSingleString(pHOWMANY);
460         Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 7);
461         return 1;
462     }
463
464
465     sciErr = getVarAddressFromPosition(pvApiCtx, 9, &piAddrpWHICH);
466     if (sciErr.iErr)
467     {
468         freeAllocatedSingleString(pBMAT);
469         freeAllocatedSingleString(pHOWMANY);
470         printError(&sciErr, 0);
471         return 1;
472     }
473
474     // Retrieve a matrix of double at position 9.
475     if (getAllocatedSingleString(pvApiCtx, piAddrpWHICH, &pWHICH))
476     {
477         freeAllocatedSingleString(pWHICH);
478         freeAllocatedSingleString(pBMAT);
479         freeAllocatedSingleString(pHOWMANY);
480         Scierror(202, _("%s: Wrong type for argument #%d: string expected.\n"), fname, 9);
481         return 1;
482     }
483
484     C2F(dseupd)(pRVEC, pHOWMANY,  pSELECT,
485                 pD, pZ,   &LDZ,
486                 pSIGMA, pBMAT, pN, pWHICH,
487                 pNEV, pTOL, pRESID,
488                 pNCV, pV, &LDV,
489                 pIPARAM, pIPNTR,
490                 pWORKD, pWORKL, &LWORKL,
491                 pINFO, 1L, 1L, 1L, 2L);
492
493     freeAllocatedSingleString(pHOWMANY);
494     freeAllocatedSingleString(pBMAT);
495
496     if (pINFO[0] < 0)
497     {
498         Scierror(998, _("%s: internal error, info=%d.\n"), fname, *pINFO);
499         return 0;
500     }
501
502     AssignOutputVariable(pvApiCtx, 1) = D;
503     AssignOutputVariable(pvApiCtx, 2) = Z;
504     AssignOutputVariable(pvApiCtx, 3) = RESID;
505     AssignOutputVariable(pvApiCtx, 4) = V;
506     AssignOutputVariable(pvApiCtx, 5) = IPARAM;
507     AssignOutputVariable(pvApiCtx, 6) = IPNTR;
508     AssignOutputVariable(pvApiCtx, 7) = WORKD;
509     AssignOutputVariable(pvApiCtx, 8) = WORKL;
510     AssignOutputVariable(pvApiCtx, 9) = INFO;
511
512     ReturnArguments(pvApiCtx);
513
514     return 0;
515 }
516 /*--------------------------------------------------------------------------*/
517