check input arguments in contr function
[scilab.git] / scilab / modules / cacsd / sci_gateway / c / sci_contr.c
1 /*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) INRIA - 
4 * Copyright (C) 2012 - Scilab Enterprises - Adeline CARNIS
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 <string.h>
16 #include "stack-c.h"
17 #include "sci_contr.h"
18 #include "Scierror.h"
19 #include "core_math.h"
20 #include "localization.h"
21 #include "stack3.h"
22 /*--------------------------------------------------------------------------*/
23 extern double C2F(dlamch)(char *CMACH, unsigned long int);
24 extern int C2F(ab01od)();
25 /*--------------------------------------------------------------------------*/
26 int intab01od(char* fname)
27 {
28     int mA = 0;
29     int nA = 0;
30     int ptrA = 0;
31     int mB = 0;
32     int nB = 0;
33     int ptrB = 0;
34     int A = 0;
35     int B = 0;
36     int U = 0;
37     int KSTAIR = 0;
38     int V = 0;
39     int ptrIWORK = 0;
40     int ptrU = 0;
41     int ptrTOL = 0;
42     int ptrKSTAIR = 0;
43     int ptrV = 0;
44     int ptrDWORK = 0;
45     int ptrJUNK = 0;
46     int ptrNCONT = 0;
47     int LDA = 0;
48     int LDB = 0;
49     int LDU = 0;
50     int LDV = 0;
51     int LDWORK = 0;
52     int N = 0;
53     int M = 0;
54     int mtol = 0;
55     int ntol = 0;
56     int un = 0;
57     int one = 0;
58     int INFO = 0;
59     int INDCON = 0;
60     int NCONT = 0;
61     char  *JOBU = NULL;
62     char *JOBV = NULL;
63     double theTOL = 0;;
64
65     /*     [NCONT,U,KSTAIR,V,A,B]=ab01od(A,B,[TOL])   */
66
67     CheckRhs(2,3);  
68     CheckLhs(1,6);
69
70     if(iIsComplex(1) || GetType(1) != sci_matrix)
71     {
72         Scierror(999,_("%s: Wrong type for input argument #%d: A real matrix expected.\n"), fname, 1);
73         return 0; 
74     }
75
76     if(iIsComplex(2) || GetType(2) != sci_matrix)
77     {
78         Scierror(999,_("%s: Wrong type for input argument #%d: A real matrix expected.\n"), fname, 2);
79         return 0; 
80     }
81
82     if(Rhs == 3)
83     {
84         if(iIsComplex(3) || GetType(3) != sci_matrix)
85         {
86             Scierror(999,_("%s: Wrong type for input argument #%d: A real scalar expected.\n"), fname, 3);
87             return 0; 
88         }
89     }
90
91     theTOL=(double) C2F(dlamch)("e",1L);
92     GetRhsVar(1,MATRIX_OF_DOUBLE_DATATYPE,&mA,&nA,&ptrA);   
93     A=1;        /*     A */
94     N=mA;
95     theTOL=0.2*sqrt(2*theTOL)*N;
96     GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE,&mB,&nB,&ptrB);   
97     B=2;        /*     B */
98     M=nB;
99
100     if (nA != mB || mA != nA )
101     { 
102         Scierror(999,_("%s: Wrong values for input arguments #%d and #%d.\n"),fname, 1, 2);  return 0; 
103     }
104     if (Rhs == 3) {
105         /*    TOL is given:   ab01od(A,B,tol)   */
106         GetRhsVar(3,MATRIX_OF_DOUBLE_DATATYPE,&mtol,&ntol,&ptrTOL);  
107         theTOL=*stk(ptrTOL);    /*     TOL */
108         if (theTOL>1.0||theTOL<0.0) {
109             Scierror(999,_("%s: Wrong value for input argument #%d: Must be in [%d %d].\n"), fname, 3, 0, 1);  return 0;
110         }
111     }
112
113     /*     dimensions...    */
114     LDA=Max(1,N);  LDB=LDA;  LDU=LDA; LDV=Max(1,M);
115     LDWORK = Max(1, N*M + Max(N,M) + Max(N,3*M));
116
117     /*     other parameters of AB01OD   */
118     JOBU= "N"; if (Lhs >= 2)  JOBU="I";
119     JOBV= "N"; if (Lhs >= 4)  JOBV="I";
120
121     /*     creating NCONT,U,KSTAIR,V,IWORK,DWORK   */
122     CreateVar(Rhs+1,MATRIX_OF_INTEGER_DATATYPE,(un=1,&un),(un=1,&un),&ptrNCONT);  NCONT=Rhs+1;
123     CreateVar(Rhs+2,MATRIX_OF_DOUBLE_DATATYPE,&N,&N,&ptrU);  U=Rhs+2;
124     CreateVar(Rhs+3,MATRIX_OF_INTEGER_DATATYPE,(un=1,&un),&N,&ptrKSTAIR);  KSTAIR=Rhs+3;
125     CreateVar(Rhs+4,MATRIX_OF_DOUBLE_DATATYPE,&M,&M,&ptrV);  V=Rhs+4;
126     CreateVar(Rhs+5,MATRIX_OF_INTEGER_DATATYPE,(un=1,&un),&M,&ptrIWORK);
127     CreateVar(Rhs+6,MATRIX_OF_DOUBLE_DATATYPE,(un=1,&un),&LDWORK,&ptrDWORK);
128     C2F(ab01od)( "A", JOBU, JOBV, &N, &M, stk(ptrA), &LDA,
129         stk(ptrB), &LDB, stk(ptrU), &LDU, stk(ptrV), &LDV,
130         istk(ptrNCONT), &INDCON, istk(ptrKSTAIR), &theTOL,
131         istk(ptrIWORK), stk(ptrDWORK), &LDWORK, &INFO );
132     if (INFO != 0) {
133         C2F(errorinfo)("ab01od", &INFO, 6L);
134         return 0;
135     }
136     if (Lhs >= 3) {
137         /*     resizing KSTAIR      */
138         CreateVar(Rhs+7,MATRIX_OF_INTEGER_DATATYPE,(un=1,&un),&INDCON,&ptrJUNK);
139         KSTAIR=Rhs+7;
140         C2F(icopy)(&INDCON,istk(ptrKSTAIR),(un=1,&un),istk(ptrJUNK),(one=1,&one)); }
141     /*     lhs variables: [NCONT,U,KSTAIR,V,A,B]=ab01od(A,B)   */
142     LhsVar(1)=NCONT; LhsVar(2)=U;
143     LhsVar(3)=KSTAIR; LhsVar(4)=V;
144     LhsVar(5)=A; LhsVar(6)=B;
145     return 0;
146 }
147 /*--------------------------------------------------------------------------*/