3aacf1d5855ea6d001a771023b44338dc8b631c9
[scilab.git] / scilab / modules / linear_algebra / src / c / schurtable.c
1
2 /*
3  * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
4  * Copyright (C) ????-2008 - INRIA
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 /*
16  * @TODO : a lot of code here could be factorized
17  */
18 /*--------------------------------------------------------------------------*/
19 #include <string.h>
20 #include "AddFunctionInTable.h"
21 #include "linear_FTables.h"
22 #include "schur.h"
23
24 /***********************************
25 * Search Table for fschur
26 ***********************************/
27
28 #define ARGS_fschur int*,double *,double*,double*,double*
29 typedef int * (*fschurf)(ARGS_fschur);
30
31
32 /***********************************
33 * Search Table for gshsel
34 ***********************************/
35
36 #define ARGS_gshsel double *,double*,double*
37 typedef int * (*gshself)(ARGS_gshsel);
38
39 /***********************************
40 * Search Table for gzhsel
41 ***********************************/
42
43 #define ARGS_gzhsel doublecmplx *,doublecmplx *
44 typedef int * (*gzhself)(ARGS_gzhsel);
45
46 /**************** fschur ***************/
47 extern void C2F(folhp)(ARGS_fschur);
48 extern void C2F(find)(ARGS_fschur);
49
50 FTAB FTab_fschur[] =
51 {
52         {"find", (voidf)  C2F(find)},
53         {"folhp", (voidf)  C2F(folhp)},
54         {(char *) 0, (voidf) 0}
55 };
56 /**************** gshsel ***************/
57 extern void C2F(sb02ow)(ARGS_gshsel);
58 extern void C2F(sb02ox)(ARGS_gshsel);
59
60 FTAB FTab_gshsel[] =
61 {
62         {"sb02ow", (voidf)  C2F(sb02ow)},
63         {"sb02ox", (voidf)  C2F(sb02ox)},
64         {(char *) 0, (voidf) 0}
65 };
66 /**************** gzhsel ***************/
67 extern void C2F(zb02ow)(ARGS_gzhsel);
68 extern void C2F(zb02ox)(ARGS_gzhsel);
69
70 FTAB FTab_gzhsel[] =
71 {
72         {"zb02ow", (voidf)  C2F(zb02ow)},
73         {"zb02ox", (voidf)  C2F(zb02ox)},
74         {(char *) 0, (voidf) 0}
75 };
76
77
78 /***********************************
79 * Search Table for schur uses : schsel
80 ***********************************/
81
82 /** the current function fixed by setschsel **/
83
84 static schself schselfonc ;
85
86 /** function call : schsel  **/
87
88 int *C2F(schsel)(double *alpha, double *beta)
89 {
90         return((*schselfonc)(alpha,beta));
91 }
92
93 /** fixes the function associated to name **/
94
95 void C2F(setschsel)(int *len, char *name, int *rep)
96 {
97         if ( ((strncmp(name,"c",1)== 0 ) && (*len==1)) || strncmp(name,"cont",4)== 0 )
98                 schselfonc = (schself) AddFunctionInTable("sb02mv",rep,FTab_schsel);
99         else if ( ((strncmp(name,"d",1)== 0) && (*len==1)) || strncmp(name,"disc",4)== 0 )
100                 schselfonc = (schself) AddFunctionInTable("sb02mw",rep,FTab_schsel);
101         else 
102                 schselfonc = (schself) AddFunctionInTable(name,rep,FTab_schsel);
103 }
104
105 /***********************************
106 * Search Table for schur uses : zchsel
107 ***********************************/
108
109 /** the current function fixed by setzschsel **/
110
111 static zchself zchselfonc ;
112
113 /** function call : zchsel  **/
114
115 int *C2F(zchsel)(doublecmplx *alpha)
116 {
117         return((*zchselfonc)(alpha));
118 }
119
120 /** fixes the function associated to name **/
121
122 void C2F(setzchsel)(int *len, char *name, int *rep)
123 {
124         if ( ((strncmp(name,"c",1)== 0) && (*len==1)) || strncmp(name,"cont",3)== 0 )
125                 zchselfonc = (zchself) AddFunctionInTable("zb02mv",rep,FTab_zchsel);
126         else if ( ( (strncmp(name,"d",1)== 0) && (*len==1) ) || strncmp(name,"disc",4)== 0 )
127                 zchselfonc = (zchself) AddFunctionInTable("zb02mw",rep,FTab_zchsel);
128         else 
129                 zchselfonc = (zchself) AddFunctionInTable(name,rep,FTab_zchsel);
130 }
131
132 /***********************************
133 * Search Table for gschur uses : gshsel
134 ***********************************/
135
136 /** the current function fixed by setgshsel **/
137
138 static gshself gshselfonc ;
139
140 /** function call : gshsel  **/
141
142 int *C2F(gshsel)(double *alphar, double *alphai, double *beta)
143 {
144         return((*gshselfonc)(alphar,alphai,beta));
145 }
146
147 /** fixes the function associated to name **/
148
149 void C2F(setgshsel)(int *len, char *name, int *rep)
150 {
151         if ( ((strncmp(name,"c",1)== 0) && (*len==1)) || strncmp(name,"cont",3)== 0 )
152                 gshselfonc = (gshself) AddFunctionInTable("sb02ow",rep,FTab_gshsel);
153         else if ( ( (strncmp(name,"d",1)== 0) && (*len==1) ) || strncmp(name,"disc",4)== 0 )
154                 gshselfonc = (gshself) AddFunctionInTable("sb02ox",rep,FTab_gshsel);
155         else 
156                 gshselfonc = (gshself) AddFunctionInTable(name,rep,FTab_gshsel);
157 }
158
159 /***********************************
160 * Search Table for gschur uses : gzhsel
161 ***********************************/
162
163 /** the current function fixed by setgzhsel **/
164
165 static gzhself gzhselfonc ;
166
167 /** function call : gzhsel  **/
168
169 int *C2F(gzhsel)(doublecmplx *alpha, doublecmplx *beta)
170 {
171         return((*gzhselfonc)(alpha,beta));
172 }
173
174 /** fixes the function associated to name **/
175
176 void C2F(setgzhsel)(int *len, char *name, int *rep)
177 {
178         if ( ((strncmp(name,"c",1)== 0) && (*len==1)) || strncmp(name,"cont",3)== 0 )
179                 gzhselfonc = (gzhself) AddFunctionInTable("zb02ow",rep,FTab_gzhsel);
180         else if ( ( (strncmp(name,"d",1)== 0) && (*len==1) ) || strncmp(name,"disc",4)== 0 )
181                 gzhselfonc = (gzhself) AddFunctionInTable("zb02ox",rep,FTab_gzhsel);
182         else 
183                 gzhselfonc = (gzhself) AddFunctionInTable(name,rep,FTab_gzhsel);
184 }
185
186 /***********************************
187 * Search Table for schur uses : fschur 
188 ***********************************/
189
190 /** the current function fixed by setsolvf **/
191
192 static fschurf fschurfonc ;
193
194 /** function call : fschur  **/
195
196 int *C2F(fschur)(int *lsize, double *alpha, double *beta, double *s, double *p)
197 {
198         return((*fschurfonc)(lsize,alpha,beta,s,p));
199 }
200
201 /** fixes the function associated to name **/
202
203 void C2F(setfschur)(char *name, int *rep)
204 {
205         if (strncmp(name,"c",1)== 0 || strncmp(name,"cont",3)== 0 )
206                 fschurfonc = (fschurf) AddFunctionInTable("folhp",rep,FTab_fschur);
207         else if (strncmp(name,"d",1)== 0 || strncmp(name,"disc",4)== 0 )
208                 fschurfonc = (fschurf) AddFunctionInTable("find",rep,FTab_fschur);
209         else 
210                 fschurfonc = (fschurf) AddFunctionInTable(name,rep,FTab_fschur);
211 }
212