b3787a4a4f2de63e104981e83d40afbc7f5e09a0
[scilab.git] / scilab / modules / scicos / sci_gateway / c / intcscicos.c
1 /*
2  * int MlistGetFieldNumber(int *ptr, const char *string)
3  * int inttimescicos(fname,fname_len)
4  * int intduplicate(fname,fname_len)
5  * int intdiffobjs(fname,fname_len)
6  * int inttree2(fname,fname_len)
7  * int inttree3(fname,fname_len)
8  * int inttree4 _PARAMS((char *fname,unsigned long fname_len))
9  * int intxproperty(fname,fname_len)
10  * int intphasesim(fname,fname_len)
11  * int intsetxproperty(fname,fname_len)
12  * int intsetblockerror(fname,fname_len)
13  * void duplicata(n,v,w,ww,nw)
14  * void comp_size(v,nw,n)
15  * int intcpass2(fname,fname_len) 
16  * int intscicosimc(fname,fname_len)
17  * int CopyVarFromlistentry(int lw, int *header, int i)
18  * int var2sci(void *x,int n,int m,int typ_var)
19  * int createblklist(scicos_block *Blocks, int *ierr)
20  * int intgetscicosvarsc(fname,fname_len)
21  * int intcurblkc(fname,fname_len)
22  * int intbuildouttb(fname)
23  */
24
25 /*     Copyright INRIA */
26 #include <string.h>
27 #include <stdio.h>
28 #include <math.h>
29
30 #include "machine.h"
31 #include "scicos_block4.h"
32 #include "intcscicos.h"
33 #include "sci_mem_alloc.h"  /* malloc */
34 #include "stack-c.h"
35 #include "sciprint.h"
36
37 #ifdef _MSC_VER
38 extern int ctree2(int* vect,int nb,int* deput,int* depuptr,int* outoin,int* outoinptr, int* ord,int* nord,int* ok);
39 extern int ctree3(int*vec,int nb,int* depu,int* depuptr,int* typl,int* bexe,int* boptr,int* blnk,int* blptr,int* ord,int* nord,int* ok);
40 extern int ctree4(int* vec,int nb,int *nd,int nnd,int* typ_r,int* outoin,int* outoinptr,int* r1,int* r2, int* nr);
41 extern int C2F(scicos)();
42 extern int C2F(namstr)();
43 #endif
44
45 /* fonction pour recuperer le nombre du champs a partir de son nom */
46 int MlistGetFieldNumber(int *ptr, const char *string)
47 {
48   int nf, longueur, istart, k, ilocal, retval;
49   int *headerstr;
50   static char str[24];
51  
52   headerstr = listentry(ptr,1);
53   nf=headerstr[1]*headerstr[2]-1;  /* number of fields */
54   retval=-1;
55   for (k=0; k<nf; k++) {
56     longueur=Min(headerstr[6+k]-headerstr[5+k],24);  /* size of kth fieldname */
57     istart=5+nf+headerstr[5+k];    /* start of kth fieldname code */
58     /*    istart=8+headerstr[4+nf+k]; */
59     C2F(cvstr)(&longueur, &headerstr[istart], str, (ilocal=1, &ilocal),longueur);
60     str[longueur]='\0';
61     if (strcmp(string, str) == 0) {
62       retval=k+2;
63       break;}
64   }
65   return retval;
66 }
67
68 int inttimescicos(fname,fname_len)
69      /* renvoi le temps de simulation t=get_scicos_time() */
70      char *fname;
71      unsigned long fname_len;
72 {
73   int un,l1;
74   CheckRhs(-1,0);
75   CheckLhs(1,1);
76   CreateVar(Rhs+1,MATRIX_OF_DOUBLE_DATATYPE,(un=1,&un),(un=1,&un),&l1);
77   *stk(l1)=get_scicos_time();
78   LhsVar(1)=Rhs+1;
79   return 0;
80 }
81
82 int intduplicate(fname,fname_len)
83
84      /* v=duplicate(u,count) 
85       * returns v=[u(1)*ones(count(1),1);
86       *            u(2)*ones(count(2),1);
87       *            ...
88       */
89
90      char *fname;
91      unsigned long fname_len;
92 {
93   int m1,m2,m3,n1,n2,n3,l1,l2,l3,n;
94   CheckRhs(2,2);
95   CheckLhs(1,1);
96   GetRhsVar(1,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l1);
97   GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE,&m2,&n2,&l2);
98   n=m1*n1;
99   if (n==0) {
100     m3=0;
101     CreateVar(Rhs+3,MATRIX_OF_DOUBLE_DATATYPE, &m3, &m3, &l3);
102     LhsVar(1) = Rhs+3;
103     return 0;
104   }
105   if (n!=m2*n2) 
106     {
107       Scierror(999,"%s: 1st and 2nd argument must have equal size\n",fname);
108       return 0;
109     }
110   comp_size(stk(l2),&n3,n);
111   m3=1;
112   CreateVar(Rhs+3,MATRIX_OF_DOUBLE_DATATYPE, &n3, &m3, &l3);
113   duplicata(&n,stk(l1),stk(l2),stk(l3),&n3);
114   LhsVar(1) = Rhs+3;
115   return 0;
116 }
117
118 int intdiffobjs(fname,fname_len)
119      /*   diffobjs(A,B) returns 0 if A==B and 1 if A and B differ */
120      char *fname;
121      unsigned long fname_len;
122 {
123   int un,l3,k;
124   int size1;int size2;
125   int *header1;int *header2;
126   CheckRhs(2,2);
127   CheckLhs(1,1);
128   header1 = GetData(1);
129   header2 = GetData(2);
130   CreateVar(Rhs+3,MATRIX_OF_DOUBLE_DATATYPE,(un=1,&un),(un=1,&un),&l3);
131   LhsVar(1) = Rhs+3;
132   size1=2*(*Lstk(Top-Rhs+2)-*Lstk(Top-Rhs+1)); 
133   size2=2*(*Lstk(Top-Rhs+3)-*Lstk(Top-Rhs+2));
134
135   if (size1 != size2) {
136     *stk(l3)=1;
137     return 0;
138   }
139   for (k=0; k<size1; k++) {
140     if (header1[k] != header2[k]) {
141       *stk(l3)=1;
142       return 0;
143     }
144     *stk(l3)=0;
145
146   }
147   return 0;
148 }
149
150 int inttree2(fname,fname_len)
151      /* [ord,ok]=ctree2(vec,outoin,outoinptr,dep_u,dep_uptr) */
152      char *fname;
153      unsigned long fname_len;
154 {
155   int un=1,ipvec,nvec,mvec,noin,moin,ipoin,noinr,moinr,ipoinr;
156   int ndep,mdep,ipdep,ndepuptr,mdepuptr,ipdepuptr,ipord,ipok,n,nord;
157
158   CheckRhs(5,5);
159   CheckLhs(2,2);
160
161   GetRhsVar(1,MATRIX_OF_INTEGER_DATATYPE,&nvec,&mvec,&ipvec);
162   GetRhsVar(2,MATRIX_OF_INTEGER_DATATYPE,&noin,&moin,&ipoin);
163   GetRhsVar(3,MATRIX_OF_INTEGER_DATATYPE,&noinr,&moinr,&ipoinr);
164   GetRhsVar(4,MATRIX_OF_INTEGER_DATATYPE,&ndep,&mdep,&ipdep);
165   GetRhsVar(5,MATRIX_OF_INTEGER_DATATYPE,&ndepuptr,&mdepuptr,&ipdepuptr);
166   n=nvec*mvec;
167   CreateVar(Rhs+6,MATRIX_OF_INTEGER_DATATYPE,&n,&un,&ipord);
168   CreateVar(Rhs+7,MATRIX_OF_INTEGER_DATATYPE,&un,&un,&ipok);
169
170   ctree2(istk(ipvec),n,istk(ipdep),istk(ipdepuptr),istk(ipoin),istk(ipoinr),
171          istk(ipord),&nord,istk(ipok));
172   *istk(iadr(C2F(intersci).iwhere[5])+1)=nord;
173
174   LhsVar(1)=Rhs+6;
175   LhsVar(2)=Rhs+7;
176
177   return 0;
178 }
179
180 int inttree3(fname,fname_len)
181      /* [r2,ok2]=ctree3(vec,dd,dep_uptr,typ_l,bexe,boptr,blnk,blptr)*/
182      char *fname;
183      unsigned long fname_len;
184 {
185   int un=1,ipvec,nvec,mvec,ntyp,mtyp,iptyp,nbex,mbex,ipbex;
186   int ndep,mdep,ipdep,ndepuptr,mdepuptr,ipdepuptr,ipord,ipok,n,nord;
187   int nbop,mbop,ipbop,nbln,mbln,ipbln,nblr,mblr,ipblr;
188   
189   CheckRhs(8,8);
190   CheckLhs(2,2);
191
192   GetRhsVar(1,MATRIX_OF_INTEGER_DATATYPE,&nvec,&mvec,&ipvec);
193   GetRhsVar(2,MATRIX_OF_INTEGER_DATATYPE,&ndep,&mdep,&ipdep);
194   GetRhsVar(3,MATRIX_OF_INTEGER_DATATYPE,&ndepuptr,&mdepuptr,&ipdepuptr);
195   GetRhsVar(4,MATRIX_OF_INTEGER_DATATYPE,&ntyp,&mtyp,&iptyp);
196   GetRhsVar(5,MATRIX_OF_INTEGER_DATATYPE,&nbex,&mbex,&ipbex);
197   GetRhsVar(6,MATRIX_OF_INTEGER_DATATYPE,&nbop,&mbop,&ipbop);
198   GetRhsVar(7,MATRIX_OF_INTEGER_DATATYPE,&nbln,&mbln,&ipbln);
199   GetRhsVar(8,MATRIX_OF_INTEGER_DATATYPE,&nblr,&mblr,&ipblr);
200   
201   n=nvec*mvec;
202   CreateVar(Rhs+9,MATRIX_OF_INTEGER_DATATYPE,&n,&un,&ipord);
203   CreateVar(Rhs+10,MATRIX_OF_INTEGER_DATATYPE,&un,&un,&ipok);
204
205   ctree3(istk(ipvec),n,istk(ipdep),istk(ipdepuptr),istk(iptyp),istk(ipbex),
206          istk(ipbop),istk(ipbln),istk(ipblr),istk(ipord),&nord,istk(ipok));
207   *istk(iadr(C2F(intersci).iwhere[8])+1)=nord;
208
209   LhsVar(1)=Rhs+9;
210   LhsVar(2)=Rhs+10;
211
212   return 0;
213 }
214
215 int inttree4 _PARAMS((char *fname,unsigned long fname_len))
216      /* [r1,r2]=ctree4(vec,outoin,outoinptr,nd,ddd) */
217 {
218   int un=1,ipvec,nvec,mvec,noin,moin,ipoin,noinr,moinr,ipoinr;
219   int nnd,mnd,ipnd,ntyp,mtyp,iptyp,ipr1,ipr2,n,nr,nn;
220   
221   CheckRhs(5,5);
222   CheckLhs(2,2);
223
224   GetRhsVar(1,MATRIX_OF_INTEGER_DATATYPE,&nvec,&mvec,&ipvec);
225   GetRhsVar(2,MATRIX_OF_INTEGER_DATATYPE,&noin,&moin,&ipoin);
226   GetRhsVar(3,MATRIX_OF_INTEGER_DATATYPE,&noinr,&moinr,&ipoinr);
227   GetRhsVar(4,MATRIX_OF_INTEGER_DATATYPE,&nnd,&mnd,&ipnd);
228   GetRhsVar(5,MATRIX_OF_INTEGER_DATATYPE,&ntyp,&mtyp,&iptyp);
229   n=nvec*mvec;
230   nn=nnd*mnd;
231   CreateVar(Rhs+6,MATRIX_OF_INTEGER_DATATYPE,&un,&nn,&ipr1);
232   CreateVar(Rhs+7,MATRIX_OF_INTEGER_DATATYPE,&un,&nn,&ipr2);
233
234   ctree4(istk(ipvec),n,istk(ipnd),mnd,istk(iptyp),istk(ipoin),
235          istk(ipoinr),istk(ipr1),istk(ipr2),&nr);
236   
237   LhsVar(1)=Rhs+6;
238   LhsVar(2)=Rhs+7;
239   /*      nbcols(6)=nr */
240   *istk(iadr(C2F(intersci).iwhere[5])+2)=nr;
241   /*      nbcols(7)=nr */
242   *istk(iadr(C2F(intersci).iwhere[6])+2)=nr;
243   return 0;
244 }
245
246
247 int intxproperty(fname,fname_len)
248      /* renvoi le type d'equation get_pointer_xproperty() 
249       * (-1: algebriques, +1 differentielles) */
250      char *fname;
251      unsigned long fname_len;
252 {
253   int un;
254   extern int* pointer_xproperty;
255   extern int n_pointer_xproperty;
256   CheckRhs(-1,0);
257   CheckLhs(1,1);
258   CreateVarFromPtr(Rhs+1,MATRIX_OF_INTEGER_DATATYPE,&n_pointer_xproperty,(un=1,&un),&pointer_xproperty);
259   LhsVar(1)=Rhs+1;
260   return 0;
261 }
262  
263 int intphasesim(fname,fname_len)
264      /* renvoi la phase de simulation phase=get_phase_simulation() */
265      char *fname;
266      unsigned long fname_len;
267
268   int un,l1;
269   CheckRhs(-1,0);
270   CheckLhs(1,1);
271   CreateVar(Rhs+1,MATRIX_OF_INTEGER_DATATYPE,(un=1,&un),(un=1,&un),&l1);
272   *istk(l1)=get_phase_simulation();
273   LhsVar(1)=Rhs+1;
274   return 0;
275 }
276
277 int intsetxproperty(fname,fname_len)
278      /* renvoi le type d'equation get_pointer_xproperty() 
279       * (-1: algebriques, +1 differentielles) */
280      char *fname;
281      unsigned long fname_len;
282 {
283   int un,l1,m1;
284   CheckRhs(1,1);
285   GetRhsVar(1,MATRIX_OF_INTEGER_DATATYPE,&m1,(un=1,&un),&l1);
286   set_pointer_xproperty(istk(l1));
287   LhsVar(1)=0; 
288   return 0;
289 }
290
291 int intsetblockerror(fname,fname_len)
292      /* renvoi le type d'equation get_pointer_xproperty() 
293       * (-1: algebriques, +1 differentielles) */
294      char *fname;
295      unsigned long fname_len;
296 {
297   int un,l1;
298   CheckRhs(1,1);
299   GetRhsVar(1,MATRIX_OF_INTEGER_DATATYPE,(un=1,&un),(un=1,&un),&l1);
300   set_block_error(*istk(l1));
301   LhsVar(1)=0; 
302   return 0;
303 }
304
305
306 void  duplicata(n,v,w,ww,nw)
307      double *v,*w,*ww;
308      int *n,*nw;
309 {
310   int i,j,k;
311   k=0;
312   for (i=0;i<*n;i++) {
313     for (j=0;j<(int) w[i];j++) {
314       ww[k]=v[i];
315       k=k+1;
316     }
317   }
318   *nw=k;
319 }
320
321 void  comp_size(v,nw,n)
322      double *v;
323      int *nw,n;
324 {  
325   int i;
326   *nw=0;
327   for (i=0;i<n;i++) {
328     if (v[i]>0) *nw=*nw+(int) v[i];
329   }
330 }
331
332 /* ******************cpass2 *************************************/
333 int intcpass2(fname,fname_len) 
334      char *fname;
335      unsigned long fname_len;
336 {
337   static int l1,l2,m1,m2,m3; 
338   static int n1,n2,n4,n5,n6,n7,n8,n9,n10,n11,n12,n13,n14,n15,n16,n43;
339   static int n17,n18,n19,n20,n21,n22,n23,n24,n25,n26,n27,n28,n29,n30;
340   static int minlhs=5, maxlhs=5, minrhs=5, maxrhs=5;
341   static int one=1,deux=2;
342   static int n33,n34,n35,n36,n37,n38,n1111,n1313,n41,n42,*y40,l40,l39;
343   int m31=8,n31=1,l31,n32=8;
344   static int *header,*li,*le1,*le11,*le2,*le3,*le4,*le5,*le6,*le7,*le8,*le9;
345   static int *le10,*le12,*le13,*header1,*lii,*le14,*le15;
346   static int m,me12,ne2,ne3,ne4,ne5,ne6,ne7,ne8,ne9,ne11,ne12,ne71,ne81;
347   static double *le66,*le77,*le88,*le1111,*le121,*le22,*le33,*le44,*le55,*le71;
348   static double *le81,*le99,*xd0k,*lc1,*rpark,*le1414,*le1515;
349   static int *le1010,*le111,*le1313,nc1,mc1,l33,l3,m4,*vecnull;
350   static char *Str1[]={ "xcs","x","z","iz","tevts","evtspt","pointi","outtb"};
351   double *y1,*y2,*y4,*y17;
352   int *y3,*y5,*y6,*y7,*y9,*y10,*y11,*y12,*y13,*y14,*y15,*y16,*y18,*y19,*y20,*y38,*y39;
353   int *y21,*y22,*y23,*y24,*y25,*y26,*y27,*y28,*y29,*y30,*y31,*y32,*y33,*y34,*y35,*y41;
354   static char *Str2[]={ "scs","funs","xptr","zptr","zcptr","inpptr","outptr","inplnk",
355                         "outlnk","lnkptr","rpar","rpptr","ipar","ipptr","clkptr","ordptr",
356                         "execlk","ordclk","cord","oord","zord","critev","nb","ztyp",
357                         "nblk","ndcblk","subscr","funtyp","iord","labels","modptr"};
358   int m33=31,n39=1,l32,n40=31;
359   char **y36,**y8,*y37;
360   int i,j,k,ok,zeros=0;
361   int *bllst2,*bllst3,*bllst4,*bllst5,*bllst12,*bllst9,*nzcross,*nmode;
362   int *bllst2ptr,*bllst3ptr,*bllst4ptr,*bllst112,*bllst6ptr,*bllst7ptr;
363   int *bllst5ptr,*typ_x,*bllst8ptr,*bllst9ptr;
364   int *bllst11ptr,*connectmat,*clkconnect;
365   int *corinvec,*corinvptr,*evtspt,pointi,*outtb,*pointiptr;
366   int *zcptr,*modptr,*nbptr,*nblkptr,*ndcblkptr; 
367   int *inplnk,*outlnk,*lnkptr,*ordptr;
368   int *execlk,*ordclk,*cord,*oord,*zord,*iz0,*subscr;
369   int *critev,nb,*ztyp,nblk,ndcblk,*iord,solver,*solverptr;
370   double *bllst6,*bllst7,*bllst8,*bllst11,*tevts,*xcd0,*ppd;
371   char **bllst111,**bllst10,**bllst13;
372   /*unsigned long str_len;*/
373   int moinsun=-1, field_num;
374   char *field_name;
375
376   xcd0=NULL;
377   ppd=NULL;
378   pointiptr=NULL;
379   nbptr=NULL;
380   nblkptr=NULL;
381   ndcblkptr=NULL;
382   /* Check number of inputs (rhs) and outputs (lhs) */
383   CheckRhs(minrhs,maxrhs) ;
384   CheckLhs(minlhs,maxlhs) ;
385   
386   header= (int*) GetData(1);
387   m=header[1];
388   if ((bllst111=MALLOC(sizeof(char*)*(m+1))) ==NULL )  return 0;                  
389   ((int*)bllst111)[0]=m;
390   if ((bllst112=MALLOC(sizeof(int)*(m+1))) ==NULL )  return 0;            
391   bllst112[0]=m;
392   if ((bllst2ptr=MALLOC(sizeof(int)*(m+2))) ==NULL )  return 0;           
393   bllst2ptr[0]=m+1;
394   bllst2ptr[1]=1;
395   if ((bllst2=MALLOC(sizeof(int))) ==NULL )  return 0;            
396   bllst2[0]=0;
397   if ((bllst3ptr=MALLOC(sizeof(int)*(m+2))) ==NULL )  return 0;           
398   bllst3ptr[0]=m+1;
399   bllst3ptr[1]=1;
400   if ((bllst3=MALLOC(sizeof(int))) ==NULL )  return 0;            
401   bllst3[0]=0;
402   if ((bllst4ptr=MALLOC(sizeof(int)*(m+2))) ==NULL )  return 0;           
403   bllst4ptr[0]=m+1;
404   bllst4ptr[1]=1;
405   if ((bllst4=MALLOC(sizeof(int))) ==NULL )  return 0;            
406   bllst4[0]=0;
407   if ((bllst5ptr=MALLOC(sizeof(int)*(m+2))) ==NULL )  return 0;           
408   bllst5ptr[0]=m+1;
409   bllst5ptr[1]=1;
410   if ((bllst5=MALLOC(sizeof(int))) ==NULL )  return 0;            
411   bllst5[0]=0;
412   if ((bllst6ptr=MALLOC(sizeof(int)*(m+2))) ==NULL )  return 0;           
413   bllst6ptr[0]=m+1;
414   bllst6ptr[1]=1;
415   if ((bllst6=MALLOC(sizeof(double))) ==NULL )  return 0;                 
416   ((int*) bllst6)[0]=0;
417   if ((bllst7ptr=MALLOC(sizeof(int)*(m+2))) ==NULL )  return 0;           
418   bllst7ptr[0]=m+1;
419   bllst7ptr[1]=1;
420   if ((bllst7=MALLOC(sizeof(double))) ==NULL )  return 0;                 
421   ((int*) bllst7)[0]=0;
422   if ((bllst8ptr=MALLOC(sizeof(int)*(m+2))) ==NULL )  return 0;           
423   bllst8ptr[0]=m+1;
424   bllst8ptr[1]=1;
425   if ((bllst8=MALLOC(sizeof(double))) ==NULL )  return 0;                 
426   ((int*) bllst8)[0]=0;
427   if ((bllst9ptr=MALLOC(sizeof(int)*(m+2))) ==NULL )  return 0;           
428   bllst9ptr[0]=m+1;
429   bllst9ptr[1]=1;
430   if ((bllst9=MALLOC(sizeof(int))) ==NULL )  return 0;            
431   bllst9[0]=0;
432   if ((nmode=MALLOC(sizeof(int)*(m+1))) ==NULL )  return 0;               
433   nmode[0]=m;
434   if ((nzcross=MALLOC(sizeof(int)*(m+1))) ==NULL )  return 0;             
435   nzcross[0]=m;  
436   if ((bllst10=(char**) MALLOC(sizeof(char *)*(m+1))) ==NULL )  return 0;                 
437   ((int*) bllst10)[0]=m;
438   if ((bllst11ptr=MALLOC(sizeof(int)*(m+2))) ==NULL )  return 0;                  
439   bllst11ptr[0]=m+1;
440   bllst11ptr[1]=1;
441   if ((bllst11=MALLOC(sizeof(double))) ==NULL )  return 0;                
442   ((int*) bllst11)[0]=0;
443   if ((bllst12=MALLOC(sizeof(int)*(m+m+1))) ==NULL )  return 0;           
444   bllst12[0]=m+m;
445   if ((bllst13=MALLOC(sizeof(char *)*(m+1))) ==NULL )  return 0;                  
446   ((int*) bllst13)[0]=m;
447   if ((xcd0=(double*)MALLOC(sizeof(double))) == NULL) return 0;
448   ((int*) xcd0)[0]=0;
449   if ((typ_x=CALLOC(m+1,sizeof(int))) ==NULL )  return 0;                 
450   typ_x[0]=m;
451   
452   for (k=1; k <= m; k++)
453     {
454       li=(int*) listentry(header,k); /*le pointeur sur la kieme sous list (mlists)*/
455       /* Le rang du champs*/
456       /* MlistGetFieldNumber*/
457       
458       /* 1ier element de la list sim*/      
459       if ((field_name=(char*) MALLOC(sizeof(char)*4)) ==NULL )  return 0;
460       ((char*) field_name)[3]='\0';
461       strcpy (field_name,"sim");
462       field_num=MlistGetFieldNumber(li,field_name);
463       le1=(int*) listentry(li,field_num);
464       FREE(field_name);
465       /*si sim est une list*/
466       if (le1[0] == 15)
467         {
468           le11=(int*) listentry(le1,1); /*sim(1)*/
469           if (le11[0] == 13)
470             {
471               if ((bllst111[k]=(char*) MALLOC(sizeof(char)*9)) ==NULL )  return 0;
472               ((char*) bllst111[k])[8]='\0';
473               strcpy (bllst111[k],"sciblock");
474               bllst112[k]=3;
475             }
476           else
477             {
478               le111=((int *) (le11+6));
479               n1111=le11[5]-1;
480               if ((bllst111[k]=(char*) MALLOC(sizeof(char)*(n1111+1))) ==NULL )  return 0;
481               ((char*) bllst111[k])[n1111]='\0';
482               C2F(cvstr)(&n1111,le111,bllst111[k],&one,(unsigned long)strlen(bllst111[k]));
483               
484               le12=(int*) listentry(le1,2); /*sim(2)*/
485               le121=((double *) (le12+4));
486               bllst112[k]=(int)le121[0];
487             }
488         }
489       else
490         {
491           le111=((int *) (le1+6));
492           bllst112[k]=0;
493           n1111=le1[5]-1;
494           if ((bllst111[k]=(char*) MALLOC(sizeof(char)*(n1111+1))) ==NULL )  return 0;
495           ((char*) bllst111[k])[n1111]='\0';
496           C2F(cvstr)(&n1111,le111,bllst111[k],&one,(unsigned long)strlen(bllst111[k]));
497
498         }
499       /* 2ieme element de la list in */
500       if ((field_name=(char*) MALLOC(sizeof(char)*3)) ==NULL )  return 0;
501       ((char*) field_name)[2]='\0';
502       strcpy (field_name,"in");
503       field_num=MlistGetFieldNumber(li,field_name);
504       FREE(field_name);
505       le2=(int*) listentry(li,field_num);
506       ne2=le2[1];
507       le22=((double *) (le2+4));
508       bllst2ptr[k+1]=bllst2ptr[k]+ne2;
509       if ((bllst2=REALLOC(bllst2,sizeof(int)*(bllst2[0]+ne2+1))) ==NULL )  return 0;    
510       for (j=0; j< ne2; j++)
511         {
512           bllst2[bllst2[0]+j+1]=(int)le22[j];
513         }
514       bllst2[0]=bllst2[0]+ne2;
515       /* 3ieme element de la list out*/
516       if ((field_name=(char*) MALLOC(sizeof(char)*4)) ==NULL )  return 0;
517       ((char*) field_name)[3]='\0';
518       strcpy (field_name,"out");
519       field_num=MlistGetFieldNumber(li,field_name);
520       FREE(field_name);
521       le3=(int*) listentry(li,field_num);
522       ne3=le3[1];
523       le33=((double *) (le3+4));
524       bllst3ptr[k+1]=bllst3ptr[k]+ne3;
525       if ((bllst3=REALLOC(bllst3,sizeof(int)*(bllst3[0]+ne3+1))) ==NULL )  return 0;
526       for (j=0; j< ne3; j++)
527         {
528           bllst3[bllst3[0]+j+1]=(int)le33[j];
529         }
530       bllst3[0]=bllst3[0]+ne3;
531       /* 4ieme element de la list evtin*/
532       if ((field_name=(char*) MALLOC(sizeof(char)*6)) ==NULL )  return 0;
533       ((char*) field_name)[5]='\0';
534       strcpy (field_name,"evtin");
535       field_num=MlistGetFieldNumber(li,field_name);
536       FREE(field_name);
537       le4=(int*) listentry(li,field_num);
538       ne4=le4[1];
539       le44=((double *) (le4+4));
540       bllst4ptr[k+1]=bllst4ptr[k]+ne4;
541       if ((bllst4=REALLOC(bllst4,sizeof(int)*(bllst4[0]+ne4+1))) ==NULL )  return 0;
542       for (j=0; j< ne4; j++)
543         {
544           bllst4[bllst4[0]+j+1]=(int)le44[j];
545         }
546       bllst4[0]=bllst4[0]+ne4;
547       /* 5ieme element de la list evtout*/
548       if ((field_name=(char*) MALLOC(sizeof(char)*7)) ==NULL )  return 0;
549       ((char*) field_name)[6]='\0';
550       strcpy (field_name,"evtout");
551       field_num=MlistGetFieldNumber(li,field_name);
552       FREE(field_name);
553       le5=(int*) listentry(li,field_num);
554       ne5=le5[1];
555       le55=((double *) (le5+4));
556       bllst5ptr[k+1]=bllst5ptr[k]+ne5;
557       if ((bllst5=REALLOC(bllst5,sizeof(int)*(bllst5[0]+ne5+1))) ==NULL )  return 0;
558       for (j=0; j< ne5; j++)
559         {
560           bllst5[bllst5[0]+j+1]=(int)le55[j];
561         }
562       bllst5[0]=bllst5[0]+ne5;
563       /* 6ieme element de la list state*/
564       if ((field_name=(char*) MALLOC(sizeof(char)*6)) ==NULL )  return 0;
565       ((char*) field_name)[5]='\0';
566       strcpy (field_name,"state");
567       field_num=MlistGetFieldNumber(li,field_name);
568       FREE(field_name);
569       le6=(int*) listentry(li,field_num);
570       ne6=le6[1];
571       le66=((double *) (le6+4));
572       if (bllst112[k]<10000)
573         {
574           if ((xcd0=(double*)REALLOC(xcd0,sizeof(double)*(((int*) xcd0)[0]+ne6+1))) == NULL ) return 0;
575           if ((bllst6=(double*)REALLOC(bllst6,sizeof(double)*(((int *) bllst6)[0]+ne6+1))) ==NULL )  return 0;
576           for (j=0;j<ne6;j++)
577             {
578               xcd0[j+((int*) xcd0)[0]+1]=0;
579               bllst6[((int *) bllst6)[0]+j+1]=le66[j];
580             }  
581           ((int*) xcd0)[0]=((int*) xcd0)[0]+ne6; 
582           ((int *) bllst6)[0]=((int *) bllst6)[0]+ne6;
583           bllst6ptr[k+1]=bllst6ptr[k]+ne6;
584         }
585       else
586         {
587           if ((xcd0=(double*)REALLOC(xcd0,sizeof(double)*(((int*) xcd0)[0]+ne6/2+1))) == NULL ) return 0;
588           if ((bllst6=(double*)REALLOC(bllst6,sizeof(double)*(((int *) bllst6)[0]+ne6/2+1))) ==NULL )  return 0;
589           for (j=0; j < ne6/2; j++)
590             {
591               xcd0[j+1+((int*) xcd0)[0]]=le66[j+ne6/2];
592               bllst6[((int *) bllst6)[0]+j+1]=le66[j];
593             }
594           ((int*) xcd0)[0]=((int*) xcd0)[0]+ne6/2;                          
595           ((int *) bllst6)[0]=((int *) bllst6)[0]+ne6/2;
596           bllst6ptr[k+1]=bllst6ptr[k]+ne6/2;
597         }
598       if ( ne6 != 0 ) typ_x[k]=1;
599       /* 7ieme element de la list dstate et le 8ieme element de la list rpar*/
600       if ((field_name=(char*) MALLOC(sizeof(char)*7)) ==NULL )  return 0;
601       ((char*) field_name)[6]='\0';
602       strcpy (field_name,"dstate");
603       field_num=MlistGetFieldNumber(li,field_name);
604       FREE(field_name);
605       le71=(double *) listentry(li,field_num);      
606       le7=(int*) listentry(li,field_num);
607       ne7= le7[1];
608       le77=((double *) (le7+4));
609
610       if ((field_name=(char*) MALLOC(sizeof(char)*5)) ==NULL )  return 0;
611       ((char*) field_name)[4]='\0';
612       strcpy (field_name,"rpar");
613       field_num=MlistGetFieldNumber(li,field_name);
614       FREE(field_name);
615       le81=(double *) listentry(li,field_num);
616       le8=(int*) listentry(li,field_num);
617       ne8=le8[1];
618       le88=((double *) (le8+4));
619       if ( bllst112[k] == 3 || bllst112[k] == 5 || bllst112[k] == 10005)
620         {
621           if (ne7 != 0)
622             {
623               ne71=li[8+2]-li[8+1];
624               if ((xd0k=(double*)MALLOC(sizeof(double)*(ne71+1))) ==NULL )  return 0;
625               ((int *) xd0k)[0]=ne71;
626
627               C2F(unsfdcopy)(&ne71,le71,&moinsun,(xd0k+1),&moinsun);
628               bllst7ptr[k+1]=bllst7ptr[k]+ne71;
629               if ((bllst7=REALLOC(bllst7,sizeof(double)*(((int *) bllst7)[0]+ne71+1))) ==NULL )  return 0;
630               for (j=1; j< ne71+1; j++)
631                 {
632                   bllst7[((int *) bllst7)[0]+j]=xd0k[j];
633                 }
634               ((int *) bllst7)[0]=((int *) bllst7)[0]+ne71;
635               FREE(xd0k);
636             }
637           else
638             {
639               bllst7ptr[k+1]=bllst7ptr[k];
640             }
641           if (ne8 != 0)
642             {
643               ne81=li[9+2]-li[9+1];
644               if ((rpark=(double*)MALLOC(sizeof(double)*(ne81+1))) ==NULL )  return 0;
645               ((int *) rpark)[0]=ne81;
646               C2F(unsfdcopy)(&ne81,le81,&moinsun,(rpark+1),&moinsun);
647
648               bllst8ptr[k+1]=bllst8ptr[k]+ne81;
649               if ((bllst8=REALLOC(bllst8,sizeof(double)*(((int *) bllst8)[0]+ne81+1))) ==NULL )  return 0;
650               for (j=1; j< ne81+1; j++)
651                 {
652                   bllst8[((int *) bllst8)[0]+j]=rpark[j];
653                 }
654               ((int *) bllst8)[0]=((int *) bllst8)[0]+ne81;
655               FREE(rpark);
656             }
657           else
658             {
659               bllst8ptr[k+1]=bllst8ptr[k];
660             }
661         }
662       else
663         {
664           bllst7ptr[k+1]=bllst7ptr[k]+ne7;
665           if ((bllst7=REALLOC(bllst7,sizeof(double)*(((int *) bllst7)[0]+ne7+1))) ==NULL )  return 0;
666           for (j=0; j< ne7; j++)
667             {
668               bllst7[((int *) bllst7)[0]+j+1]=le77[j];
669             }
670           ((int *) bllst7)[0]=((int *) bllst7)[0]+ne7;
671
672           bllst8ptr[k+1]=bllst8ptr[k]+ne8;
673           if ((bllst8=REALLOC(bllst8,sizeof(double)*(((int *) bllst8)[0]+ne8+1))) ==NULL )  return 0;
674           for (j=0; j< ne8; j++)
675             {
676               bllst8[((int *) bllst8)[0]+j+1]=le88[j];
677             }
678           ((int *) bllst8)[0]=((int *) bllst8)[0]+ne8;
679         }
680       /* 9ieme element de la list ipar*/
681       if ((field_name=(char*) MALLOC(sizeof(char)*5)) ==NULL )  return 0;
682       ((char*) field_name)[4]='\0';
683       strcpy (field_name,"ipar");
684       field_num=MlistGetFieldNumber(li,field_name);
685       FREE(field_name);
686       le9=(int*) listentry(li,field_num);
687       if (le9[0] == 1)
688         {
689           ne9=le9[1];
690           le99=((double *) (le9+4));
691           bllst9ptr[k+1]=bllst9ptr[k]+ne9;
692           if ((bllst9=REALLOC(bllst9,sizeof(int)*(bllst9[0]+ne9+1))) ==NULL )  return 0;
693           for (j=0; j< ne9; j++)
694             {
695               bllst9[bllst9[0]+j+1]=(int)le99[j];
696             }
697           bllst9[0]=bllst9[0]+ne9;
698         }
699       else 
700         {
701           bllst9ptr[k+1]=bllst9ptr[k];
702         }
703       /* 10ieme element de la list typeblock*/
704       if ((field_name=(char*) MALLOC(sizeof(char)*10)) ==NULL )  return 0;
705       ((char*) field_name)[9]='\0';
706       strcpy (field_name,"blocktype");
707       field_num=MlistGetFieldNumber(li,field_name);
708       FREE(field_name);
709       le10=(int*) listentry(li,field_num);
710       le1010=((int *) (le10+6));      
711       if ((bllst10[k]=(char*) MALLOC(sizeof(char)*2)) ==NULL )  return 0;
712       ((char*) bllst10[k])[1]='\0';
713       C2F(cvstr)(&one,le1010,bllst10[k],&one,(unsigned long)strlen(bllst10[k]));
714       /* 11ieme element de la list firing*/
715       if ((field_name=(char*) MALLOC(sizeof(char)*7)) ==NULL )  return 0;
716       ((char*) field_name)[6]='\0';
717       strcpy (field_name,"firing");
718       field_num=MlistGetFieldNumber(li,field_name);
719       FREE(field_name);
720       le11=(int*) listentry(li,field_num);
721       ne11=le11[2];
722       le1111=((double *) (le11+4));
723       bllst11ptr[k+1]=bllst11ptr[k]+ne11;
724       if ((bllst11=REALLOC(bllst11,sizeof(double)*(((int *) bllst11)[0]+ne11+1))) ==NULL )  return 0;
725       for (j=0; j< ne11; j++)
726         {
727           bllst11[((int *) bllst11)[0]+j+1]=le1111[j];
728         }
729       ((int *) bllst11)[0]=((int *) bllst11)[0]+ne11;
730       /* 12ieme element de la list dep_ut*/
731       if ((field_name=(char*) MALLOC(sizeof(char)*7)) ==NULL )  return 0;
732       ((char*) field_name)[6]='\0';
733       strcpy (field_name,"dep_ut");
734       field_num=MlistGetFieldNumber(li,field_name);
735       FREE(field_name);
736       le12=(int*) listentry(li,field_num);
737       ne12=le12[1];
738       me12=le12[2];
739       /*le1212=((double *) (le12+3));*/
740       bllst12[k]=le12[3];
741       bllst12[k+m]=le12[4];
742       /* 13ieme element de la list label*/
743       if ((field_name=(char*) MALLOC(sizeof(char)*6)) ==NULL )  return 0;
744       ((char*) field_name)[5]='\0';
745       strcpy (field_name,"label");
746       field_num=MlistGetFieldNumber(li,field_name);
747       FREE(field_name);
748       le13=(int*) listentry(li,field_num);
749       le1313=((int *) (le13+6));
750
751       n1313=le13[5]-1;
752       if ((bllst13[k]=(char*) MALLOC(sizeof(char)*(n1313+1))) ==NULL )  return 0;
753       ((char*) bllst13[k])[n1313]='\0'; 
754       C2F(cvstr)(&n1313,le1313,bllst13[k],&one,(unsigned long)strlen(bllst13[k]));
755      /* 14ieme element de la list nzcross*/
756       if ((field_name=(char*) MALLOC(sizeof(char)*8)) ==NULL )  return 0;
757       ((char*) field_name)[7]='\0';
758       strcpy (field_name,"nzcross");
759       field_num=MlistGetFieldNumber(li,field_name);
760       FREE(field_name);
761       le14=(int*) listentry(li,field_num);
762       le1414=((double *) (le14+4));
763       nzcross[k]=(int)le1414[0];
764      /* 15ieme element de la list nmode*/
765       if ((field_name=(char*) MALLOC(sizeof(char)*6)) ==NULL )  return 0;
766       ((char*) field_name)[5]='\0';
767       strcpy (field_name,"nmode");
768       field_num=MlistGetFieldNumber(li,field_name);
769       FREE(field_name);
770       le15=(int*) listentry(li,field_num);
771       le1515=((double *) (le15+4));
772       nmode[k]=(int)le1515[0];
773     }
774   
775   GetRhsVar(2,MATRIX_OF_INTEGER_DATATYPE, &m1, &n1, &l1);
776   GetRhsVar(3,MATRIX_OF_INTEGER_DATATYPE, &m2, &n2, &l2);
777   if ((connectmat=MALLOC((m1*n1+1)*sizeof(int))) ==NULL )  return 0;              
778   connectmat[0]=m1*n1;
779   for(i=0;i<n1;i++)
780     {
781       for(j=1;j<m1+1;j++)
782         {
783           connectmat[j+i*m1]=*istk(l1+j+i*m1-1);
784         }
785     }
786   if ((clkconnect=MALLOC((m2*n2+1)*sizeof(int))) ==NULL )  return 0;              
787   clkconnect[0]=m2*n2;
788   for(i=0;i<n2;i++)
789     {
790       for(j=1;j<m2+1;j++)
791         {
792           clkconnect[j+i*m2]=*istk(l2+j+i*m2-1);
793         }
794     }
795  
796   if ((corinvec=MALLOC(sizeof(int))) ==NULL )  return 0;
797   corinvec[0]=0;
798   header1= (int*) GetData(4);
799   m3=header1[1];
800   if ((corinvptr=MALLOC(sizeof(int)*(m3+2))) ==NULL )  return 0;
801   corinvptr[0]=m3+1;
802   corinvptr[1]=1;
803   for (k=1; k <= m3; k++)
804     {
805       lii=(int*) listentry(header1,k); /*le pointeur sur la kieme vecteur*/
806       lc1=((double *) (lii+4));
807       nc1=lii[1];
808       mc1=lii[2];
809       if ((corinvec=REALLOC(corinvec,sizeof(int)*(corinvec[0]+nc1*mc1+1))) ==NULL )  return 0;
810       for (j=0; j< nc1*mc1; j++)
811         {
812           corinvec[corinvec[0]+j+1]=(int)lc1[j];
813         }
814       corinvec[0]=corinvec[0]+nc1*mc1;
815       corinvptr[k+1]=corinvptr[k]+nc1*mc1;
816
817     }
818   
819   GetRhsVar(5,MATRIX_OF_INTEGER_DATATYPE, &one, &m4, &l3); 
820   solver=*istk(l3);
821   
822   cpass2(&bllst111,&bllst112,&bllst2,&bllst3,&bllst4,&bllst5,&bllst9,&bllst10,&bllst11,
823          &bllst12,&bllst13,&nmode,&nzcross,&bllst2ptr,&bllst3ptr,&bllst4ptr,&bllst5ptr,&bllst6ptr,&bllst9ptr,&typ_x,
824          &bllst11ptr,&connectmat,&clkconnect,&corinvec,&corinvptr,
825          &iz0,&tevts,&evtspt,&pointi,&outtb,&zcptr,&modptr,&outlnk,&inplnk,
826          &lnkptr,&ordptr,&execlk,&ordclk,&cord,&oord,&zord,&critev,&nb,&ztyp,
827          &nblk,&ndcblk,&subscr,&iord,&ok);
828   if (!ok) 
829     {
830       CreateVar(Rhs+11,MATRIX_OF_INTEGER_DATATYPE, &one, &zeros, &l31);
831       CreateVar(Rhs+12,MATRIX_OF_INTEGER_DATATYPE, &one, &zeros, &l32);
832       CreateVar(Rhs+13,MATRIX_OF_INTEGER_DATATYPE, &one, &zeros, &l33);
833       CreateVar(Rhs+14,MATRIX_OF_INTEGER_DATATYPE, &one, &zeros, &l39);
834       CreateVar(Rhs+15,MATRIX_OF_INTEGER_DATATYPE, &one, &zeros, &l40);
835       LhsVar(1) = Rhs+11;
836       LhsVar(2) = Rhs+12;
837       LhsVar(3) = Rhs+13;
838       LhsVar(4) = Rhs+14;
839       LhsVar(5) = Rhs+15;
840       return 0;
841     }
842   if (nb > nblk)
843     {
844       if ((bllst8ptr=REALLOC(bllst8ptr,sizeof(int)*(nb+2))) ==NULL )  return 0;           
845       bllst8ptr[0]=nb+1;
846       if ((bllst7ptr=REALLOC(bllst7ptr,sizeof(int)*(nb+2))) ==NULL )  return 0;           
847       bllst7ptr[0]=nb+1;
848       if ((bllst6ptr=REALLOC(bllst6ptr,sizeof(int)*(nb+2))) ==NULL )  return 0;           
849       bllst6ptr[0]=nb+1;
850       for (i=nblk+1; i<nb+1; i++)
851         {
852
853           bllst8ptr[i+1]=bllst8ptr[i];
854           bllst7ptr[i+1]=bllst7ptr[i];
855           bllst6ptr[i+1]=bllst6ptr[i];
856         }
857     }
858   if ((Max1(bllst112)>10000) && (solver==0))
859     {
860       Message("Diagram contains implicit blocks, compiling for implicit Solver");
861       solver=100;
862     }
863   if (solver==100)
864     {
865       if ((bllst6=(double*)REALLOC(bllst6,sizeof(double)*(((int*) bllst6)[0]+((int*) xcd0)[0]+1))) == NULL ) return 0;
866       ppd=(double *)&bllst6[1+((int*) bllst6)[0]];
867       ppd=memcpy(ppd,&xcd0[1],sizeof(double)*(((int*) xcd0)[0]));
868       ((int*) bllst6)[0]=((int*) bllst6)[0]+((int*) xcd0)[0];
869     }
870   if (xcd0) FREE(xcd0);
871   /******************* state **************************/
872   
873   if ((pointiptr=MALLOC(sizeof(int))) ==NULL )  return 0;                 
874   pointiptr[0]=pointi;
875   y1 = (double*) (bllst6+1);
876   y2 = (double*) (bllst7+1);
877   n4=((int*) bllst6)[0];
878   n5=((int*) bllst7)[0];
879   if (!iz0)
880     {
881       if ((iz0=MALLOC(sizeof(int))) ==NULL )  return 0;           
882       iz0[0]=0;
883     }
884   y3=(int*) (iz0+1);
885   n6=iz0[0];
886   y4 = (double*) (tevts+1);
887   y5=(int*) (evtspt+1);
888   y6=pointiptr;
889   y7=(int*) (outtb+1);
890   n7=(int) tevts[0];
891   n8= evtspt[0];
892   n9= outtb[0];
893   CreateVar(6,TYPED_LIST_DATATYPE, &m31, &n31, &l31);
894   CreateListVarFromPtr(6,1,MATRIX_OF_STRING_DATATYPE, &one, &n32, Str1);
895   CreateListVarFromPtr(6,2,MATRIX_OF_DOUBLE_DATATYPE, &n4, &one,  &y1);
896   CreateListVarFromPtr(6,3,MATRIX_OF_DOUBLE_DATATYPE, &n5, &one,  &y2);
897   CreateListVarFromPtr(6,4,MATRIX_OF_INTEGER_DATATYPE, &n6, &one,  &y3);
898   CreateListVarFromPtr(6,5,MATRIX_OF_DOUBLE_DATATYPE, &n7, &one,  &y4);
899   CreateListVarFromPtr(6,6,MATRIX_OF_INTEGER_DATATYPE, &n8, &one,  &y5);
900   CreateListVarFromPtr(6,7,MATRIX_OF_INTEGER_DATATYPE, &one, &one, &y6);
901   CreateListVarFromPtr(6,8,MATRIX_OF_INTEGER_DATATYPE, &n9, &one,  &y7);
902   LhsVar(1) = 6;
903   FREE(iz0);
904   FREE(tevts);
905   FREE(evtspt);
906   FREE(outtb);
907   /********************** sim *****************/
908   CreateVar(7,TYPED_LIST_DATATYPE, &m33, &n39, &l32);
909   CreateListVarFromPtr(7,1,MATRIX_OF_STRING_DATATYPE, &one, &n40, Str2);
910   y8=(char**) (bllst111+1);
911   n10=(int) bllst111[0];
912   y9=(int*) (bllst6ptr+1);
913   n11=bllst6ptr[0];
914   y10=(int*) (bllst7ptr+1);
915   n12=bllst7ptr[0];
916   y11=(int*) (zcptr+1);
917   n13=zcptr[0];
918   y41=(int*) (modptr+1);
919   n43=modptr[0];
920   y12=(int*) (bllst2ptr+1);
921   n14=bllst2ptr[0];
922   y13=(int*) (bllst3ptr+1);
923   n15=bllst3ptr[0];
924   y14=(int*) (inplnk+1);
925   n16=inplnk[0];
926   y15=(int*) (outlnk+1);
927   n17=outlnk[0];
928   y16=(int*) (lnkptr+1);
929   n18=lnkptr[0];
930   y17=(double*) (bllst8+1);
931   n19=((int*) bllst8)[0];
932   y18=(int*) (bllst8ptr+1);
933   n20=bllst8ptr[0];
934   y19=(int*) (bllst9+1);
935   n21=bllst9[0];
936   y20=(int*) (bllst9ptr+1);
937   n22=bllst9ptr[0];
938   y21=(int*) (bllst5ptr+1);
939   n23=bllst5ptr[0];
940   y22=(int*) (ordptr+1);
941   n24=ordptr[0];
942   y23=(int*) (execlk+1);
943   n25=execlk[0]/2;
944   y24=(int*) (ordclk+1);
945   n26=ordclk[0]/2;
946   if (!cord)
947     {
948       if ((cord=MALLOC(sizeof(int))) ==NULL )  return 0;                  
949       cord[0]=0;
950     }
951   y25=(int*) (cord+1);
952   n27=cord[0]/2;
953   if (!oord)
954     {
955       if ((oord=MALLOC(sizeof(int))) ==NULL )  return 0;                  
956       oord[0]=0;
957     }
958   y26=(int*) (oord+1);
959   n28=oord[0]/2;
960   if (!zord)
961     {
962       if ((zord=MALLOC(sizeof(int))) ==NULL )  return 0;                  
963       zord[0]=0;
964     }
965   y27=(int*) (zord+1);
966   n29=zord[0]/2;
967   y28=(int*) (critev+1);
968   n30=critev[0];
969   if ((nbptr=MALLOC(sizeof(int))) ==NULL )  return 0;             
970   nbptr[0]=nb;
971   y29=nbptr;
972   y30=(int*) (ztyp+1);
973   n33=ztyp[0];
974   if ((nblkptr=MALLOC(sizeof(int))) ==NULL )  return 0;           
975   nblkptr[0]=nblk;
976   y31=nblkptr;
977   if ((ndcblkptr=MALLOC(sizeof(int))) ==NULL )  return 0;                 
978   ndcblkptr[0]=ndcblk;
979   y32=ndcblkptr;
980   if (!subscr)
981     {
982       if ((subscr=MALLOC(sizeof(int))) ==NULL )  return 0;                
983       subscr[0]=0;
984     }
985   y33=(int*) (subscr+1);
986   n34=subscr[0]/2;
987   y34=(int*) (bllst112+1);
988   n35=bllst112[0];
989   if (!iord)
990     {
991       if ((iord=MALLOC(sizeof(int))) ==NULL )  return 0;                  
992       iord[0]=0;
993     }
994   y35=(int*) (iord+1);
995   n36=iord[0]/2;
996   y36=(char**) (bllst13+1);
997   n37=(int) bllst13[0];
998   if ((vecnull=MALLOC(sizeof(int))) ==NULL )  return 0;           
999   y38=(int*) (vecnull+1);
1000   n41=0;
1001   
1002   CreateListVarFromPtr(7,2,MATRIX_OF_INTEGER_DATATYPE, &n41, &one, &y38);
1003   CreateListVarFromPtr(7,3,MATRIX_OF_INTEGER_DATATYPE, &n11, &one, &y9);
1004   CreateListVarFromPtr(7,4,MATRIX_OF_INTEGER_DATATYPE, &n12,&one,  &y10);
1005   CreateListVarFromPtr(7,5,MATRIX_OF_INTEGER_DATATYPE, &n13, &one, &y11);
1006   CreateListVarFromPtr(7,6,MATRIX_OF_INTEGER_DATATYPE, &n14,&one,  &y12);
1007   CreateListVarFromPtr(7,7,MATRIX_OF_INTEGER_DATATYPE, &n15,&one,  &y13);
1008   CreateListVarFromPtr(7,8,MATRIX_OF_INTEGER_DATATYPE, &n16, &one, &y14);
1009   CreateListVarFromPtr(7,9,MATRIX_OF_INTEGER_DATATYPE, &n17, &one, &y15);
1010   CreateListVarFromPtr(7,10,MATRIX_OF_INTEGER_DATATYPE, &n18, &one, &y16);
1011   CreateListVarFromPtr(7,11,MATRIX_OF_DOUBLE_DATATYPE, &n19,&one,  &y17);
1012   CreateListVarFromPtr(7,12,MATRIX_OF_INTEGER_DATATYPE, &n20, &one, &y18);
1013   CreateListVarFromPtr(7,13,MATRIX_OF_INTEGER_DATATYPE, &n21, &one, &y19);
1014   CreateListVarFromPtr(7,14,MATRIX_OF_INTEGER_DATATYPE, &n22, &one, &y20);
1015   CreateListVarFromPtr(7,15,MATRIX_OF_INTEGER_DATATYPE, &n23, &one, &y21);
1016   CreateListVarFromPtr(7,16,MATRIX_OF_INTEGER_DATATYPE, &n24, &one, &y22);
1017   CreateListVarFromPtr(7,17,MATRIX_OF_INTEGER_DATATYPE, &n25, &deux, &y23);
1018   CreateListVarFromPtr(7,18,MATRIX_OF_INTEGER_DATATYPE, &n26, &deux, &y24);
1019   CreateListVarFromPtr(7,19,MATRIX_OF_INTEGER_DATATYPE, &n27, &deux, &y25);
1020   CreateListVarFromPtr(7,20,MATRIX_OF_INTEGER_DATATYPE, &n28, &deux,&y26);
1021   CreateListVarFromPtr(7,21,MATRIX_OF_INTEGER_DATATYPE, &n29, &deux, &y27);
1022   CreateListVarFromPtr(7,22,MATRIX_OF_INTEGER_DATATYPE, &n30, &one, &y28);
1023   CreateListVarFromPtr(7,23,MATRIX_OF_INTEGER_DATATYPE, &one, &one, &y29);
1024   CreateListVarFromPtr(7,24,MATRIX_OF_INTEGER_DATATYPE, &n33, &one, &y30);
1025   CreateListVarFromPtr(7,25,MATRIX_OF_INTEGER_DATATYPE, &one, &one, &y31);
1026   CreateListVarFromPtr(7,26,MATRIX_OF_INTEGER_DATATYPE, &one, &one, &y32);
1027   CreateListVarFromPtr(7,27,MATRIX_OF_INTEGER_DATATYPE, &n34, &one, &y33);
1028   CreateListVarFromPtr(7,28,MATRIX_OF_INTEGER_DATATYPE, &n35,&one,  &y34);
1029   CreateListVarFromPtr(7,29,MATRIX_OF_INTEGER_DATATYPE, &n36, &deux, &y35);
1030   CreateListVarFromPtr(7,30,MATRIX_OF_STRING_DATATYPE, &n37, &one, y36);
1031   CreateListVarFromPtr(7,31,MATRIX_OF_INTEGER_DATATYPE, &n43, &one, &y41);
1032   LhsVar(2) = 7;
1033   
1034   FREE(zcptr);
1035   FREE(modptr);
1036   FREE(inplnk);
1037   FREE(outlnk);
1038   FREE(lnkptr);
1039   FREE(ordptr);
1040   FREE(execlk);
1041   FREE(ordclk);
1042   FREE(cord);
1043   FREE(oord);
1044   FREE(zord);
1045   FREE(critev);
1046   FREE(ztyp);
1047   FREE(subscr);
1048   FREE(iord);
1049   FREE(bllst112);
1050   FREE(bllst2);
1051   FREE(bllst2ptr);
1052   FREE(bllst3);
1053   FREE(bllst3ptr);
1054   FREE(bllst4);
1055   FREE(bllst4ptr);
1056   FREE(bllst5);
1057   FREE(bllst5ptr);
1058   FREE(bllst6);
1059   FREE(bllst6ptr);
1060   FREE(bllst7);
1061   FREE(bllst7ptr);
1062   FREE(bllst8);
1063   FREE(bllst8ptr);
1064   FREE(bllst9);
1065   FREE(bllst9ptr);
1066   for(i = 1; i < ((int*) bllst10)[0]+1; i++)
1067     FREE(bllst10[i]);
1068   FREE(bllst10);
1069   FREE(bllst11);
1070   FREE(bllst11ptr);
1071   FREE(bllst12);
1072   for(i = 1; i < ((int*) bllst13)[0]+1; i++)
1073     FREE(bllst13[i]);
1074   FREE(bllst13);  
1075   FREE(nzcross);
1076   FREE(nmode);
1077   if(ndcblkptr) FREE(ndcblkptr);
1078   if (pointiptr) FREE(pointiptr);
1079   if (nbptr) FREE(nbptr);
1080   if (nblkptr) FREE(nblkptr);
1081   FREE(connectmat); 
1082   FREE(vecnull);
1083
1084   CreateVar(8,LIST_DATATYPE, &n10, &one, &l33);
1085   for (i=0; i < n10; i++)
1086     {
1087       n38=(int)strlen(y8[i]);
1088       y37=*(y8+i);
1089       CreateListVarFromPtr(8,i+1,STRING_DATATYPE, &n38, &one, &y37); 
1090     }
1091   LhsVar(3) = 8;
1092   for (i = 1; i <= nb; i++)
1093     FREE(bllst111[i]);
1094   FREE(bllst111);
1095   
1096   if ((solverptr=MALLOC(sizeof(int))) ==NULL )  return 0;                 
1097   solverptr[0]=solver;
1098   y39=solverptr;
1099   CreateVarFromPtr(Rhs+9,MATRIX_OF_INTEGER_DATATYPE, &one, &one, &y39);
1100   LhsVar(4) = Rhs+9;
1101   FREE(solverptr);
1102
1103   CreateVar(Rhs+10,LIST_DATATYPE, &nb, &one, &l40);
1104   for (i=1; i < nb+1; i++)
1105     {      
1106       y40=(int*) (corinvec+corinvptr[i]);
1107       n42=corinvptr[i+1]-corinvptr[i];
1108       CreateListVarFromPtr(10,i,MATRIX_OF_INTEGER_DATATYPE, &one, &n42, &y40); 
1109     }
1110   LhsVar(5) = Rhs+10;
1111   FREE(corinvec);
1112   FREE(corinvptr);
1113   return 0;
1114 }
1115
1116 /* intsicosimc scicosim interface routine.
1117  *
1118  * [state,t] = scicosim(state,tcur,tf,sim,str,tol)
1119  *
1120  * rhs 1 state : Tlist
1121  *        - 1  : state(1)     : !xcs  x  z  iz  tevts  evtspt  pointi  outtb  !
1122  *        - 2  : state.x      : column vector of real
1123  *        - 3  : state.z      : column vector of real
1124  *        - 4  : state.iz     : column vector of real (empty object with flag "finish")
1125  *        - 5  : state.tevts  : column vector of real
1126  *        - 6  : state.evtspt : column vector of int32
1127  *        - 7  : state.pointi : int32 scalar
1128  *        - 8  : state.outtb  : list of scilab object
1129  * rhs 2 tcur  : real scalar
1130  * rhs 3 tf    : real scalar
1131  * rhs 4 sim   : Tlist
1132  *        - 1  : sim(1) : !scs     funs    xptr    zptr    zcptr   inpptr
1133  *                         outptr  inplnk  outlnk  rpar    rpptr   ipar
1134  *                         ipptr   clkptr  ordptr  execlk  ordclk  cord
1135  *                         oord    zord    critev  nb      ztyp    nblk
1136  *                         ndcblk  subscr  funtyp  iord    labels  modptr  !
1137  *        - 2  : sim.funs   : list of strings and/or scilab function
1138  *        - 3  : sim.xptr   : column vector of int32
1139  *        - 4  : sim.zptr   : column vector of int32
1140  *        - 5  : sim.zcptr  : column vector of int32
1141  *        - 6  : sim.inpptr : column vector of int32
1142  *        - 7  : sim.outptr : column vector of int32
1143  *        - 8  : sim.inplnk : column vector of int32
1144  *        - 9  : sim.outlnk : column vector of int32
1145  *        - 10 : sim.rpar   : column vector of real
1146  *        - 11 : sim.rpptr  : column vector of int32
1147  *        - 12 : sim.ipar   : column vector of int32
1148  *        - 13 : sim.ipptr  : column vector of int32
1149  *        - 14 : sim.clkptr : column vector of int32
1150  *        - 15 : sim.ordptr : column vector of int32
1151  *        - 16 : sim.execlk : matrix of int32
1152  *        - 17 : sim.ordclk : matrix of int32
1153  *        - 18 : sim.cord   : matrix of int32
1154  *        - 19 : sim.oord   : matrix of int32
1155  *        - 20 : sim.zord   : column vector ? of int32
1156  *        - 21 : sim.critev : column vector of int32
1157  *        - 22 : sim.nb     : int32 scalar
1158  *        - 23 : sim.ztyp   : column vector of int32
1159  *        - 24 : sim.nblk   : int32 scalar
1160  *        - 25 : sim.ndcblk : int32 scalar
1161  *        - 26 : sim.subscr : column vector of int32
1162  *        - 27 : sim.funtyp : column vector of int32
1163  *        - 28 : sim.iord   : column vector of int32
1164  *        - 29 : sim.labels : column vector of strings
1165  *        - 30 : sim.modptr : column vector of int32
1166  *
1167  * rhs 5 str   : string flag : 'start','run','finish','linear'
1168  * rhs 6 tol   : real vector of size (7,1) minimum (4,1)
1169  *               [atol rtol ttol [deltat realtimescale solver hmax]]'
1170  *
1171  * 16/03/06, A.Layec : Rewritten from original fortran
1172  * source code intsscicos in intcos.f.
1173  *
1174  * 29/03/06, Alan    : Improvement in accordance to c_pass2
1175  * (int32 parameters)
1176  *
1177  * 31/05/06, Alan    : Add global variable int *il_state_save
1178  * and int *il_sim_save in intcscicos.h to store stack address
1179  * of list %cpr.state and %cpr.sim (to use with
1180  * get/setscicosvars)
1181  *
1182  * 14/06/06, Alan    : Save common intersci before calling scicos
1183  * (to disable scilab crash with scifunc.f)
1184  */
1185
1186 /* prototype */
1187 int intscicosimc(fname,fname_len)
1188                  char *fname;
1189                  unsigned long fname_len;
1190 {
1191  /*********************************************
1192   * external structure and function declaration
1193   *********************************************/
1194  /*declaration of funnum (in scicos.c)*/
1195  extern int C2F(funnum) __PARAMS((char *fname));
1196
1197  /************************************
1198   * variables and constants définition
1199   ************************************/
1200  static int id[nsiz];
1201
1202  /*declaration of static structure*/
1203  static struct {integer idb;} C2F(dbcos);   /*declaration of dbcos*/
1204
1205  typedef struct inter_s_ 
1206  {
1207    int iwhere,nbrows,nbcols,itflag,ntypes,lad,ladc,lhsvar;
1208  } intersci_state ;
1209
1210  typedef struct inter_l 
1211  {
1212   intersci_state *state ;
1213   int nbvars;
1214  } intersci_list ;
1215  intersci_list *loc;
1216  intersci_state *new ;
1217
1218  /* declaration of outtb_elem */
1219  outtb_el *outtb_elem=NULL;
1220  static int nelem;
1221
1222  /*auxilary variables for dimension and address*/
1223  static int m1;                  /*state*/
1224  static int *il_state;
1225  static int m1e2,n1e2;           /*state.x*/
1226  static int *il_state_x;
1227  static double *l_state_x;
1228  static int m1e3,n1e3;           /*state.z*/
1229  static int *il_state_z;
1230  static double *l_state_z;
1231  static int m1e4,n1e4;           /*state.iz*/
1232  static int *il_state_iz;
1233  static double *l_state_iz;
1234  static int m1e5,n1e5;           /*state.tevts*/
1235  static int *il_state_tevts;
1236  static double *l_state_tevts;
1237  static int m1e6,n1e6;           /*state.evtspt*/
1238  static int *il_state_evtspt;
1239  static int *l_state_evtspt;
1240  static int m1e7,n1e7;           /*state.pointi*/
1241  static int *il_pointi;
1242  static int *l_pointi;
1243  static int *il_state_outtb;     /*state.outtb*/
1244  static int nlnk;
1245  static void **outtbptr;
1246  static int *outtbsz;
1247  static int *outtbtyp;
1248
1249  static int m2,n2;               /*tcur*/
1250  static int *il_tcur;
1251  static double *l_tcur;
1252
1253  static int m3,n3;               /*tf*/
1254  static int *il_tf;
1255  static double *l_tf;
1256
1257  static int m4,n4,l4,il4;        /*sim*/
1258  static int *il_sim;
1259  static int l4e2,il4e2;          /*sim.funs*/
1260  static int *il_sim_fun;
1261  static int nblk;
1262  static int m4e3,n4e3;           /*sim.xptr*/
1263  static int *il_sim_xptr;
1264  static int *l_sim_xptr;
1265  static int m4e4,n4e4;           /*sim.zptr*/
1266  static int *il_sim_zptr;
1267  static int *l_sim_zptr;
1268  static int m4e5,n4e5;           /*sim.zcptr*/
1269  static int *il_sim_zcptr;
1270  static int *l_sim_zcptr;
1271  static int m4e6,n4e6;           /*sim.inpptr*/
1272  static int *il_sim_inpptr;
1273  static int *l_sim_inpptr;
1274  static int m4e7,n4e7;           /*sim.outptr*/
1275  static int *il_sim_outptr;
1276  static int *l_sim_outptr;
1277  static int m4e8,n4e8;           /*sim.inplnk*/
1278  static int *il_sim_inplnk;
1279  static int *l_sim_inplnk;
1280  static int m4e9,n4e9;           /*sim.outlnk*/
1281  static int *il_sim_outlnk;
1282  static int *l_sim_outlnk;
1283  static int m4e10,n4e10;         /*sim.rpar*/
1284  static int *il_sim_rpar;
1285  static double *l_sim_rpar;
1286  static int m4e11,n4e11;         /*sim.rpptr*/
1287  static int *il_sim_rpptr;
1288  static int *l_sim_rpptr;
1289  static int m4e12,n4e12;         /*sim.ipar*/
1290  static int *il_sim_ipar;
1291  static int *l_sim_ipar;
1292  static int m4e13,n4e13;         /*sim.ipptr*/
1293  static int *il_sim_ipptr;
1294  static int *l_sim_ipptr;
1295  static int m4e14,n4e14;         /*sim.clkptr*/
1296  static int *il_sim_clkptr;
1297  static int *l_sim_clkptr;
1298  static int m4e15,n4e15;         /*sim.ordptr*/
1299  static int *il_sim_ordptr;
1300  static int *l_sim_ordptr;
1301  static int m4e16,n4e16;         /*sim.execlk*/
1302  static int *il_sim_execlk;
1303  static int *l_sim_execlk;
1304  static int m4e17,n4e17;         /*sim.ordclk*/
1305  static int *il_sim_ordclk;
1306  static int *l_sim_ordclk;
1307  static int m4e18,n4e18;         /*sim.cord*/
1308  static int *il_sim_cord;
1309  static int *l_sim_cord;
1310  static int m4e19,n4e19;         /*sim.oord*/
1311  static int *il_sim_oord;
1312  static int *l_sim_oord;
1313  static int m4e20,n4e20;         /*sim.zord*/
1314  static int *il_sim_zord;
1315  static int *l_sim_zord;
1316  static int m4e21,n4e21;         /*sim.critev*/
1317  static int *il_sim_critev;
1318  static int *l_sim_critev;
1319  static int m4e22,n4e22;         /*sim.nb*/
1320  static int *il_sim_nb;
1321  static int *l_sim_nb;
1322  static int m4e23,n4e23;         /*sim.ztyp*/
1323  static int *il_sim_ztyp;
1324  static int *l_sim_ztyp;
1325  static int m4e24,n4e24;         /*sim.nblk*/
1326  static int *il_sim_nblk;
1327  static int *l_sim_nblk;
1328  static int m4e25,n4e25;         /*sim.ndcblk*/
1329  static int *il_sim_ndcblk;
1330  static int *l_sim_ndcblk;
1331  static int m4e26,n4e26;         /*sim.subscr*/
1332  static int *il_sim_subscr;
1333  static int *l_sim_subscr;
1334  static int m4e27,n4e27;         /*sim.funtyp*/
1335  static int *il_sim_funtyp;
1336  static int *l_sim_funtyp;
1337  static int m4e28,n4e28;         /*sim.iord*/
1338  static int *il_sim_iord;
1339  static int *l_sim_iord;
1340  static int m4e29,n4e29;         /*sim.labels*/
1341  static int *il_sim_lab;
1342  static int *il_sim_labptr;
1343  static int *l_sim_lab;
1344  static int m4e30,n4e30;         /*sim.modptr*/
1345  static int *il_sim_modptr;
1346  static int *l_sim_modptr;
1347
1348  static int m5,n5;               /*str*/
1349  static int *il_str;
1350  static int *l_str;
1351  static int flag;
1352
1353  static int m6,n6;               /*tol*/
1354  static int *il_tol;
1355  static double *l_tol;
1356
1357  /*auxilary variables*/
1358  static double simpar[7];
1359  static int solver;
1360  static int *lfunpt;     /*for function table*/
1361  static int lf,ilf,ifun; /*for function table*/
1362  static int ierr,istate; /*error variable of scicos.c*/
1363
1364  /*local variable*/
1365  int *subheader; /*pointer to get address of a subvariable in a list*/
1366  int i,j,k;        /*local counter variable*/
1367  int sz_str;     /*local variable to store size of string*/
1368  int err_check;  /*local variable for cross var. checking dimension*/
1369
1370  /*definition of min/max input/output argument*/
1371  static int minlhs=1, maxlhs=2, minrhs=6, maxrhs=6;
1372
1373  /*************************************
1374   * Check number of inputs and outputs
1375   *************************************/
1376  CheckRhs(minrhs,maxrhs);
1377  CheckLhs(minlhs,maxlhs);
1378
1379  /****************
1380   * state (rhs 1)
1381   ****************/
1382  il_state = (int *) GetData(1);
1383  il_state_save = il_state; /* make a copy of il_state in a global variabe */
1384  if(il_state[0]!=16) /*Check if state is a tlist*/
1385  {
1386   Scierror(56,"%s : First argument must be a Tlist.\n",fname);
1387   Err=1;
1388   return 0;
1389  }
1390  m1 = il_state[1];
1391
1392     /*2 : state.x      */
1393     il_state_x = (int *) (listentry(il_state,2));
1394     l_state_x  = (double *) (il_state_x+4);
1395     m1e2 = il_state_x[1];
1396     n1e2 = il_state_x[2];
1397
1398     /*3 : state.z      */
1399     il_state_z = (int *) (listentry(il_state,3));
1400     l_state_z  = (double *) (il_state_z+4);
1401     m1e3 = il_state_z[1];
1402     n1e3 = il_state_z[2];
1403
1404     /*4 : state.iz     */
1405     il_state_iz = (int *) (listentry(il_state,4));
1406     l_state_iz  = (double *) (il_state_iz+4);
1407     m1e4 = il_state_iz[1];
1408     n1e4 = il_state_iz[2];
1409
1410     /*5 : state.tevts  */
1411     il_state_tevts = (int *) (listentry(il_state,5));
1412     l_state_tevts  = (double *) (il_state_tevts+4);
1413     m1e5 = il_state_tevts[1];
1414     n1e5 = il_state_tevts[2];
1415
1416     /*6 : state.evtspt */
1417     il_state_evtspt = (int *) (listentry(il_state,6));
1418     l_state_evtspt  = (int *) (il_state_evtspt+4);
1419     m1e6 = il_state_evtspt[1];
1420     n1e6 = il_state_evtspt[2];
1421
1422     /*7 : state.pointi */
1423     il_pointi = (int *) (listentry(il_state,7));
1424     l_pointi = (int *) (il_pointi+4);
1425     m1e7 = il_pointi[1];
1426     n1e7 = il_pointi[2];
1427
1428     /*8 : state.outtb  */
1429     il_state_outtb = (int *) (listentry(il_state,8));
1430     if(il_state_outtb[0]!=15) /*check if il_state_outtb is a list*/
1431     {
1432      Scierror(56,"%s : outtb element of state must be a list.\n",fname);
1433      Err=4;
1434      return 0;
1435     }
1436     nlnk = il_state_outtb[1]; /*nlnk is the dimension of the list state_louttb*/
1437
1438  /***************
1439   * tcur (rhs 2)
1440   ***************/
1441  il_tcur = (int *) GetData(2);
1442  if(il_tcur[0]!=1) /*Check if tcur is a real or complex matrix*/
1443  {
1444   Scierror(53,"%s : Second argument must be a scalar.\n",fname);
1445   Err=2;
1446   return 0;
1447  }
1448  l_tcur = (double *) (il_tcur+4);
1449  m2 = il_tcur[1];
1450  n2 = il_tcur[2];
1451  CheckScalar(2,m2,n2);
1452  CheckDims(2,m2,n2,1,1);
1453
1454  /*************
1455   * tf (rhs 3)
1456   *************/
1457  il_tf = (int *) GetData(3);
1458  if(il_tf[0]!=1) /*Check if tf is a real or complex matrix*/
1459  {
1460   Scierror(53,"%s : Third argument must be a scalar.\n",fname);
1461   Err=3;
1462   return 0;
1463  }
1464  l_tf = (double *) (il_tf+4);
1465  m3 = il_tf[1];
1466  n3 = il_tf[2];
1467  CheckScalar(3,m3,n3);
1468  CheckDims(3,m3,n3,1,1);
1469
1470  /*************
1471   * sim (rhs 4)
1472   *************/
1473  il_sim = (int *) GetData(4);
1474  if(il_sim[0]!=16)  /*Check if sim is a tlist*/
1475  {
1476   Scierror(56,"%s : Fourth argument must be a Tlist.\n",fname);
1477   Err=4;
1478   return 0;
1479  }
1480  m4 = il_sim[1];
1481  n4 = il_sim[2];
1482  il_sim_save = il_sim; /* make a copy of il_sim in a global variabe */
1483
1484     /*2  : sim.funs*/
1485     il_sim_fun = (int *) (listentry(il_sim,2));
1486     if(il_sim_fun[0]!=15) /*check if sim.funs is a list*/
1487     {
1488      Scierror(56,"%s : Second element of sim must be a list.\n",fname);
1489      Err=4;
1490      return 0;
1491     }
1492     nblk = il_sim_fun[1]; /*nblk is the dimension of the list sim.funs*/
1493
1494     /*3  : sim.xptr   */
1495     il_sim_xptr = (int *) (listentry(il_sim,3));
1496     m4e3 = il_sim_xptr[1];
1497     n4e3 = il_sim_xptr[2];
1498     l_sim_xptr = (int *) (il_sim_xptr+4);
1499
1500     /*4  : sim.zptr   */
1501     il_sim_zptr = (int *) (listentry(il_sim,4));
1502     m4e4 = il_sim_zptr[1];
1503     n4e4 = il_sim_zptr[2];
1504     l_sim_zptr = (int *) (il_sim_zptr+4);
1505
1506     /*5  : sim.zcptr  */
1507     il_sim_zcptr = (int *) (listentry(il_sim,5));
1508     m4e5 = il_sim_zcptr[1];
1509     n4e5 = il_sim_zcptr[2];
1510     l_sim_zcptr = (int *) (il_sim_zcptr+4);
1511
1512     /*6  : sim.inpptr */
1513     il_sim_inpptr = (int *) (listentry(il_sim,6));
1514     m4e6 = il_sim_inpptr[1];
1515     n4e6 = il_sim_inpptr[2];
1516     l_sim_inpptr = (int *) (il_sim_inpptr+4);
1517
1518     /*7  : sim.outptr */
1519     il_sim_outptr = (int *) (listentry(il_sim,7));
1520     m4e7 = il_sim_outptr[1];
1521     n4e7 = il_sim_outptr[2];
1522     l_sim_outptr = (int *) (il_sim_outptr+4);
1523
1524     /*8  : sim.inplnk */
1525     il_sim_inplnk = (int *) (listentry(il_sim,8));
1526     m4e8 = il_sim_inplnk[1];
1527     n4e8 = il_sim_inplnk[2];
1528     l_sim_inplnk = (int *) (il_sim_inplnk+4);
1529
1530     /*9  : sim.outlnk */
1531     il_sim_outlnk = (int *) (listentry(il_sim,9));
1532     m4e9 = il_sim_outlnk[1];
1533     n4e9 = il_sim_outlnk[2];
1534     l_sim_outlnk = (int *) (il_sim_outlnk+4);
1535
1536     /*10 : sim.rpar   */
1537     il_sim_rpar = (int *) (listentry(il_sim,10));
1538     m4e10 = il_sim_rpar[1];
1539     n4e10 = il_sim_rpar[2];
1540     l_sim_rpar = (double *) (il_sim_rpar+4);
1541
1542     /*11 : sim.rpptr  */
1543     il_sim_rpptr = (int *) (listentry(il_sim,11));
1544     m4e11 = il_sim_rpptr[1];
1545     n4e11 = il_sim_rpptr[2];
1546     l_sim_rpptr = (int *) (il_sim_rpptr+4);
1547
1548     /*12 : sim.ipar   */
1549     il_sim_ipar = (int *) (listentry(il_sim,12));
1550     m4e12 = il_sim_ipar[1];
1551     n4e12 = il_sim_ipar[2];
1552     l_sim_ipar = (int *) (il_sim_ipar+4);
1553
1554     /*13 : sim.ipptr  */
1555     il_sim_ipptr = (int *) (listentry(il_sim,13));
1556     m4e13 = il_sim_ipptr[1];
1557     n4e13 = il_sim_ipptr[2];
1558     l_sim_ipptr = (int *) (il_sim_ipptr+4);
1559
1560     /*14 : sim.clkptr */
1561     il_sim_clkptr = (int *) (listentry(il_sim,14));
1562     m4e14 = il_sim_clkptr[1];
1563     n4e14 = il_sim_clkptr[2];
1564     l_sim_clkptr = (int *) (il_sim_clkptr+4);
1565
1566     /*15 : sim.ordptr */
1567     il_sim_ordptr = (int *) (listentry(il_sim,15));
1568     m4e15 = il_sim_ordptr[1];
1569     n4e15 = il_sim_ordptr[2];
1570     l_sim_ordptr = (int *) (il_sim_ordptr+4);
1571
1572     /*16 : sim.execlk */
1573     il_sim_execlk = (int *) (listentry(il_sim,16));
1574     m4e16 = il_sim_execlk[1];
1575     n4e16 = il_sim_execlk[2];
1576     l_sim_execlk = (int *) (il_sim_execlk+4);
1577
1578     /*17 : sim.ordclk */
1579     il_sim_ordclk = (int *) (listentry(il_sim,17));
1580     m4e17 = il_sim_ordclk[1];
1581     n4e17 = il_sim_ordclk[2];
1582     l_sim_ordclk = (int *) (il_sim_ordclk+4);
1583
1584     /*18 : sim.cord   */
1585     il_sim_cord = (int *) (listentry(il_sim,18));
1586     m4e18 = il_sim_cord[1];
1587     n4e18 = il_sim_cord[2];
1588     l_sim_cord = (int *) (il_sim_cord+4);
1589
1590     /*19 : sim.oord   */
1591     il_sim_oord = (int *) (listentry(il_sim,19));
1592     m4e19 = il_sim_oord[1];
1593     n4e19 = il_sim_oord[2];
1594     l_sim_oord = (int *) (il_sim_oord+4);
1595
1596     /*20 : sim.zord   */
1597     il_sim_zord = (int *) (listentry(il_sim,20));
1598     m4e20 = il_sim_zord[1];
1599     n4e20 = il_sim_zord[2];
1600     l_sim_zord = (int *) (il_sim_zord+4);
1601
1602     /*21 : sim.critev */
1603     il_sim_critev = (int *) (listentry(il_sim,21));
1604     m4e21 = il_sim_critev[1];
1605     n4e21 = il_sim_critev[2];
1606     l_sim_critev = (int *) (il_sim_critev+4);
1607
1608     /*22 : sim.nb     */
1609     il_sim_nb = (int *) (listentry(il_sim,22));
1610     m4e22 = il_sim_nb[1];
1611     n4e22 = il_sim_nb[2];
1612     l_sim_nb = (int *) (il_sim_nb+4);
1613     if (l_sim_nb[0]!=nblk) /*value of nb must be equal to nblk*/
1614     {
1615      Scierror(42,"%s : Incompatible sim.nb RHS parameter.\n",fname);
1616      return 0;
1617     }
1618
1619     /*23 : sim.ztyp   */
1620     il_sim_ztyp = (int *) (listentry(il_sim,23));
1621     m4e23 = il_sim_ztyp[1];
1622     n4e23 = il_sim_ztyp[2];
1623     l_sim_ztyp = (int *) (il_sim_ztyp+4);
1624
1625     /*24 : sim.nblk   */
1626     il_sim_nblk = (int *) (listentry(il_sim,24));
1627     m4e24 = il_sim_nblk[1];
1628     n4e24 = il_sim_nblk[2];
1629     l_sim_nblk = (int *) (il_sim_nblk+4);
1630
1631     /*25 : sim.ndcblk */
1632     il_sim_ndcblk = (int *) (listentry(il_sim,25));
1633     m4e25 = il_sim_ndcblk[1];
1634     n4e25 = il_sim_ndcblk[2];
1635     l_sim_ndcblk = (int *) (il_sim_ndcblk+4);
1636
1637     /*26 : sim.subscr */
1638     il_sim_subscr = (int *) (listentry(il_sim,26));
1639     m4e26 = il_sim_subscr[1];
1640     n4e26 = il_sim_subscr[2];
1641     l_sim_subscr = (int *) (il_sim_subscr+4);
1642
1643     /*27 : sim.funtyp */
1644     il_sim_funtyp = (int *) (listentry(il_sim,27));
1645     m4e27 = il_sim_funtyp[1];
1646     n4e27 = il_sim_funtyp[2];
1647     l_sim_funtyp = (int *) (il_sim_funtyp+4);
1648
1649     /*28 : sim.iord   */
1650     il_sim_iord = (int *) (listentry(il_sim,28));
1651     m4e28 = il_sim_iord[1];
1652     n4e28 = il_sim_iord[2];
1653     l_sim_iord = (int *) (il_sim_iord+4);
1654
1655     /*29 : sim.labels */
1656      il_sim_lab = (int *) (listentry(il_sim,29));
1657      m4e29 = il_sim_lab[1];
1658      n4e29 = il_sim_lab[2];
1659      il_sim_labptr = &il_sim_lab[4];  /*get address-1 of first pointer in labels*/
1660      l_sim_lab = (int *) (il_sim_lab+m4e29+5); /*get address of first string in labels*/
1661
1662     /*30 : sim.modptr */
1663     il_sim_modptr = (int *) (listentry(il_sim,30));
1664     m4e30 = il_sim_modptr[1];
1665     n4e30 = il_sim_modptr[2];
1666     l_sim_modptr= (int *) (il_sim_modptr+4);
1667
1668  /*************
1669   * str (rhs 5)
1670   *************/
1671  il_str = (int *) GetData(5);
1672  m5 = il_str[1];
1673  n5 = il_str[2];
1674  l_str = (int *) (il_str+6);
1675  CheckDims(5,m5,n5,m5,1);
1676
1677  sz_str=il_str[5]-1; /*store the length of str*/
1678  C2F(cha1).buf[0]=' ';
1679  C2F(cvstr)(&sz_str,&l_str[0],&C2F(cha1).buf[0],(j=1,&j),sz_str); /*codetoascii*/
1680  C2F(cha1).buf[sz_str]='\0';
1681  if (strcmp(C2F(cha1).buf,"start") == 0) flag=1;
1682  else if (strcmp(C2F(cha1).buf,"run") == 0) flag=2;
1683  else if (strcmp(C2F(cha1).buf,"finish") == 0) flag=3;
1684  else if (strcmp(C2F(cha1).buf,"linear") == 0) flag=4;
1685  else
1686  {
1687   Scierror(44,"%s : Fifth argument is incorrect.\n",fname);
1688   Err=5;
1689   return 0;
1690  }
1691
1692  /*************
1693   * tol (rhs 6)
1694   *************/
1695  il_tol = (int *) GetData(6);
1696  l_tol = (double *) (il_tol+4);
1697  m6 = il_tol[1];
1698  n6 = il_tol[2];
1699  m6 = m6*n6;
1700  if (m6<4) /*Check if tol has a minimun of four elements*/
1701  {
1702   Scierror(89,"%s : Sixth argument must have at least four elements.\n",fname); 
1703   Err=6;
1704   return 0; 
1705  }
1706  else if(m6>7) /*Check if tol has a maximum of seven elements*/
1707  {
1708   Scierror(89,"%s : Sixth argument must have a maximum of seven elements.\n",fname);
1709   Err=6;
1710   return 0;
1711  }
1712
1713  /******************
1714   * set simpar array
1715   ******************/
1716  if (m6==4) {for(i=0;i<4;i++) simpar[i]=l_tol[i];simpar[4]=0;simpar[5]=0;simpar[6]=0;}
1717  else if (m6==5) {for(i=0;i<5;i++) simpar[i]=l_tol[i];simpar[5]=0;simpar[6]=0;}
1718  else if (m6==6) {for(i=0;i<6;i++) simpar[i]=l_tol[i];simpar[6]=0;}
1719  else for(i=0;i<7;i++) simpar[i]=l_tol[i];
1720  solver=(int)simpar[5]; /*set solver variable*/
1721
1722  /******************************
1723   * cross variable size checking
1724   ******************************/
1725  err_check = 0;
1726  if (m1e5!=m1e6)       err_check=1;        /*tevts vs evtspt*/
1727  else if (m4e3!=m4e4)  err_check=2;        /*xptr vs zptr*/
1728  else if (m4e3!=m4e5)  err_check=3;        /*xptr vs zcptr*/
1729  else if (m4e3!=m4e6)  err_check=4;        /*xptr vs npptr*/
1730  else if (m4e3!=m4e7)  err_check=5;        /*xptr vs outptr*/
1731  else if (m4e3!=m4e11) err_check=6;        /*xptr vs rpptr*/
1732  else if (m4e3!=m4e13) err_check=7;        /*xptr vs ipptr*/
1733  else if (m4e3!=m4e14) err_check=8;        /*xptr vs clkptr*/
1734  else if ((n4e17!=2)&(m4e17!=0)) err_check=9;  /*sim.ordclk*/
1735  else if ((n4e18!=2)&(m4e18!=0)) err_check=10; /*sim.cord*/
1736  else if ((n4e19!=2)&(m4e19!=0)) err_check=11; /*sim.oord*/
1737  else if ((n4e20!=2)&(m4e20!=0)) err_check=12; /*sim.zord*/
1738  else if ((n4e28!=2)&(m4e28!=0)) err_check=13; /*sim.iord*/
1739  if (err_check!=0)
1740  {
1741   /* please write an error table here  */
1742   Scierror(42,"%s : error in cross variable size checking : %d\n",\
1743            fname,err_check);
1744   return 0;
1745  }
1746
1747  /*******************************
1748   * set function table for blocks
1749   *******************************/
1750  il4 = iadr(*Lstk(Top-Rhs+4));  /*sim*/
1751  l4 = sadr(il4+m4+3);
1752  il4e2 = iadr(l4+*istk(il4+3)-1);
1753  l4e2 = sadr(il4e2+nblk+3);
1754  lf = l4e2;  /*first element of the list sim.funs*/
1755  /*define new variable lfunpt*/
1756  if ((lfunpt=(int *) MALLOC(nblk*sizeof(int))) ==NULL )
1757  {
1758   return 0;
1759  }
1760
1761  /*for each block*/
1762  for (i=0;i<nblk;i++)
1763  {
1764    ilf=iadr(lf); /*should be removed later*/
1765    subheader=(int *)(listentry(il_sim_fun,i+1));
1766    /*Block is defined by a scilab function*/
1767    if ((subheader[0]==11)|(subheader[0]==13)) lfunpt[i]=-lf;
1768    /*Block is defined by a function described by a characater strings*/
1769    else if(subheader[0]==10)
1770    {
1771     sz_str=subheader[5]-1; /*store the length of function name*/
1772     C2F(cha1).buf[0]=' ';
1773     C2F(cvstr)(&sz_str,&subheader[6],&C2F(cha1).buf[0],(j=1,&j),sz_str); /*codetoascii*/
1774     C2F(cha1).buf[sz_str]='\0';
1775     ifun=C2F(funnum)(C2F(cha1).buf); /*search associated function number of function name*/
1776     /*Block is defined by a C or Fortran function*/
1777     if (ifun>0) lfunpt[i]=ifun;
1778     /*Block is defined by a predefined scilab function*/
1779     else 
1780     {
1781       C2F(namstr)(id,&subheader[6],&sz_str,(j=0,&j));
1782       Fin=0;
1783       C2F(funs)(id);
1784       if ((C2F(com).fun==-1)|(C2F(com).fun==-2)) lfunpt[i]=-*Lstk(Fin);
1785       else 
1786       {
1787        C2F(curblk).kfun=i+1;
1788        Scierror(888,"%s : unknown block : %s\n",fname,C2F(cha1).buf);
1789        FREE(lfunpt);
1790        return 0;
1791       }
1792     }
1793    }
1794    else 
1795    {
1796      Err=4;
1797      Scierror(44,"%s : error\n",fname);
1798      FREE(lfunpt);
1799      return 0;
1800    }
1801    lf=lf+*istk(il4e2+3+i)-*istk(il4e2+i+2);
1802  }
1803
1804  /*******************************
1805   * set outtbptr,outtbsz,outtbtyp
1806   *******************************/
1807  /*Allocation of outtbptr*/
1808  if ((outtbptr=(void **) MALLOC(nlnk*sizeof(void *)))==NULL )
1809  {
1810   FREE(lfunpt);
1811   return 0;
1812  }
1813  /*Allocation of outtbsz*/
1814  if ((outtbsz=(int *) MALLOC(nlnk*2*sizeof(int)))==NULL )
1815  {
1816   FREE(outtbptr);
1817   FREE(lfunpt);
1818   return 0;
1819  }
1820  /*Allocation of outtbtyp*/
1821  if ((outtbtyp=(int *) MALLOC(nlnk*sizeof(int)))==NULL )
1822  {
1823   FREE(outtbsz);
1824   FREE(outtbptr);
1825   FREE(lfunpt);
1826   return 0;
1827  }
1828
1829  /*initalize nelem*/
1830  nelem=0;
1831
1832  /*set vectors of outtb*/
1833  for (j=0;j<nlnk;j++) /*for each link*/
1834  {
1835   subheader=(int *)(listentry(il_state_outtb,j+1)); /*get header of outtbl(j+1)*/
1836   outtbsz[j*2]=subheader[1]; /*store dimensions*/
1837   outtbsz[(j*2)+1]=subheader[2];
1838
1839   switch (subheader[0]) /*store type and address*/
1840   {
1841    /*matrix of double*/
1842    case 1  : switch (subheader[3])
1843              {
1844               case 0  : outtbtyp[j]=10;  /*double real matrix*/
1845                         outtbptr[j]=(double *)(subheader+4);
1846                         break;
1847
1848               case 1  : outtbtyp[j]=11;  /*double complex matrix*/
1849                         outtbptr[j]=(double *)(subheader+4);
1850                         break;
1851
1852               default : Scierror(888,\
1853                                 "%s : error. Type %d of double scalar matrix not yet supported.\n",\
1854                                 fname,subheader[3]);
1855                         FREE(outtbptr);
1856                         FREE(outtbtyp);
1857                         FREE(outtbsz);
1858                         FREE(lfunpt);
1859                         if (outtb_elem!=NULL) FREE(outtb_elem);
1860                         break;
1861              }
1862              break;
1863
1864    /*matrix of integers*/
1865    case 8  : switch (subheader[3])
1866              {
1867               case 1  : outtbtyp[j]=81;  /*int8*/
1868                         outtbptr[j]=(char *)(subheader+4);
1869                         break;
1870
1871               case 2  : outtbtyp[j]=82;  /*int16*/
1872                         outtbptr[j]=(short *)(subheader+4);
1873                         break;
1874
1875               case 4  : outtbtyp[j]=84;  /*int32*/
1876                         outtbptr[j]=(long *)(subheader+4);
1877                         break;
1878
1879               case 11 : outtbtyp[j]=811; /*uint8*/
1880                         outtbptr[j]=(unsigned char *)(subheader+4);
1881                         break;
1882
1883               case 12 : outtbtyp[j]=812; /*uint16*/
1884                         outtbptr[j]=(unsigned short *)(subheader+4);
1885                         break;
1886
1887               case 14 : outtbtyp[j]=814; /*uint32*/
1888                         outtbptr[j]=(unsigned long *)(subheader+4);
1889                         break;
1890
1891               default : Scierror(888,\
1892                                 "%s : error. Type %d of integer scalar matrix not yet supported.\n",\
1893                                 fname,subheader[3]);
1894                         FREE(outtbptr);
1895                         FREE(outtbtyp);
1896                         FREE(outtbsz);
1897                         FREE(lfunpt);
1898                         if (outtb_elem!=NULL) FREE(outtb_elem);
1899                         break;
1900              }
1901              break;
1902
1903
1904    default : Scierror(888,"%s : error. Type %d not yet supported.\n",fname,subheader[0]);
1905              FREE(outtbptr);
1906              FREE(outtbtyp);
1907              FREE(outtbsz);
1908              FREE(lfunpt);
1909              if (outtb_elem!=NULL) FREE(outtb_elem);
1910              return 0;
1911              break;
1912   }
1913
1914   /* store lnk and pos in outtb_elem */
1915   k=nelem;
1916   nelem+=outtbsz[j*2]*outtbsz[(j*2)+1];
1917   if ((outtb_elem=(outtb_el *) REALLOC(outtb_elem,nelem*sizeof(outtb_el)))==NULL)
1918   {
1919    Scierror(999,"%s : No more memory.\n",fname);
1920    FREE(outtbptr);
1921    FREE(outtbtyp);
1922    FREE(outtbsz);
1923    FREE(lfunpt);
1924    if (outtb_elem!=NULL) FREE(outtb_elem);
1925    return 0;
1926   }
1927   for (i=0;i<outtbsz[j*2]*outtbsz[(j*2)+1];i++)
1928   {
1929    outtb_elem[k+i].lnk=j;
1930    outtb_elem[k+i].pos=i;
1931   }
1932  }
1933
1934  /********************************
1935   * save intersci common
1936   * see intersci_push in stack2.c
1937   ********************************/
1938   Nbvars = Rhs; /*because of the use of getdata*/
1939   new = MALLOC(Rhs*sizeof(intersci_state));
1940   if (new == NULL)
1941   {
1942    FREE(outtbptr);
1943    FREE(outtbtyp);
1944    FREE(outtbsz);
1945    FREE(lfunpt);
1946    FREE(outtb_elem);
1947    return 0;
1948   }
1949   loc = MALLOC(sizeof(intersci_list));
1950   if (loc == NULL)
1951   {
1952    FREE(outtbptr);
1953    FREE(outtbtyp);
1954    FREE(outtbsz);
1955    FREE(lfunpt);
1956    FREE(outtb_elem);
1957    FREE(new);
1958    return 0;
1959   }
1960   loc->state = new; 
1961   loc->nbvars = Nbvars;
1962   for (i=0;i<Rhs;i++)
1963   {
1964    loc->state[i].iwhere = C2F(intersci).iwhere[i];
1965    loc->state[i].ntypes = C2F(intersci).ntypes[i];
1966    loc->state[i].lad    = C2F(intersci).lad[i];
1967    loc->state[i].lhsvar = C2F(intersci).lhsvar[i];
1968   }
1969
1970  /************************
1971   * call scicos simulator
1972   ************************/
1973  if (C2F(iop).ddt!=0) C2F(dbcos).idb=1;   /*debug mode if ddt=0*/
1974
1975  /* Calling sequence :
1976   *   int C2F(scicos)
1977   *   (x_in, xptr_in, z__, work,zptr,modptr_in, iz, izptr, t0_in, tf_in, tevts_in, 
1978   *    evtspt_in, nevts, pointi_in, outtbptr_in, outtbsz_in, outtbtyp_in, nlnk1,
1979   *    funptr, funtyp_in, inpptr_in, outptr_in,
1980   *    inplnk_in, outlnk_in, rpar, rpptr, ipar, ipptr, clkptr_in,
1981   *    ordptr_in, nordptr1, ordclk_in, cord_in, ncord1, iord_in, niord1, oord_in, noord1,
1982   *    zord_in, nzord1, critev_in, nblk1, ztyp, zcptr_in, subscr, nsubs, simpar,
1983   *    flag__, ierr_out)
1984   *
1985   *   double *x_in,*z__;
1986   *   void **work;
1987   *   integer *modptr_in;
1988   *   integer *xptr_in;
1989   *   integer *zptr, *iz, *izptr;
1990   *   double *t0_in, *tf_in, *tevts_in;
1991   *   integer *evtspt_in, *nevts, *pointi_in;
1992   *   void **outtbptr_in;
1993   *   integer *outtbsz_in;
1994   *   integer *outtbtyp_in;
1995   *   integer *nlnk1, *funptr, *funtyp_in, *inpptr_in, *outptr_in;
1996   *   integer *inplnk_in, *outlnk_in;
1997   *   double *rpar;
1998   *   integer *rpptr, *ipar, *ipptr, *clkptr_in, *ordptr_in, *nordptr1;
1999   *   integer *ordclk_in, *cord_in, *ncord1, *iord_in, *niord1, *oord_in;
2000   *   integer *noord1, *zord_in, *nzord1, *critev_in, *nblk1, *ztyp, *zcptr_in;
2001   *   integer *subscr, *nsubs;
2002   *   double *simpar;
2003   *   integer *flag__, *ierr_out;
2004   */
2005
2006 C2F(scicos)(l_state_x,l_sim_xptr,l_state_z, \
2007              l_state_iz,l_sim_zptr, \
2008              l_sim_modptr, \
2009              l_sim_lab,il_sim_labptr,l_tcur,l_tf,l_state_tevts, \
2010              l_state_evtspt,&m1e5,l_pointi,outtbptr,outtbsz,outtbtyp,outtb_elem,&nelem,&nlnk, \
2011              lfunpt,l_sim_funtyp,l_sim_inpptr, \
2012              l_sim_outptr,l_sim_inplnk,l_sim_outlnk,  \
2013              l_sim_rpar,l_sim_rpptr, \
2014              l_sim_ipar,l_sim_ipptr,l_sim_clkptr, \
2015              l_sim_ordptr,&m4e15, \
2016              l_sim_ordclk,l_sim_cord,&m4e18, \
2017              l_sim_iord,&m4e28, \
2018              l_sim_oord,&m4e19,l_sim_zord, &m4e20, \
2019              l_sim_critev,&nblk,l_sim_ztyp,l_sim_zcptr, \
2020              l_sim_subscr,&m4e26,simpar,&flag,&ierr);
2021
2022  C2F(dbcos).idb=0;  /*return in normal mode*/
2023
2024  /******************************
2025   * retrieve intersci common
2026   * see intersci_pop in stack2.c
2027   ******************************/
2028  Nbvars = loc->nbvars;
2029  for (i=0;i<Rhs;i++)
2030  {
2031   C2F(intersci).iwhere[i] = loc->state[i].iwhere ;
2032   C2F(intersci).ntypes[i] = loc->state[i].ntypes ;
2033   C2F(intersci).lad[i]    = loc->state[i].lad    ;
2034   C2F(intersci).lhsvar[i] = loc->state[i].lhsvar ;
2035  }
2036  FREE(loc->state);
2037  FREE(loc);
2038
2039  /**********************
2040   * Free allocated array
2041   **********************/
2042  FREE(outtbptr);
2043  FREE(outtbtyp);
2044  FREE(outtbsz);
2045  FREE(lfunpt);
2046  FREE(outtb_elem);
2047
2048  /*************************************
2049   * switch to appropriate message error
2050   *************************************/
2051  if (ierr>0)
2052  {
2053   switch (ierr)
2054   {
2055    case 1  : strcpy(C2F(cha1).buf,"scheduling problem");
2056              C2F(curblk).kfun=0;
2057              break;
2058
2059    case 2  : strcpy(C2F(cha1).buf,"input to zero-crossing stuck on zero");
2060              C2F(curblk).kfun=0;
2061              break;
2062
2063    case 3  : strcpy(C2F(cha1).buf,"event conflict");
2064              C2F(curblk).kfun=0;
2065              break;
2066
2067    case 4  : strcpy(C2F(cha1).buf,"algrebraic loop detected");
2068              C2F(curblk).kfun=0;
2069              break;
2070
2071    case 5  : strcpy(C2F(cha1).buf,"cannot allocate memory");
2072              C2F(curblk).kfun=0;
2073              break;
2074
2075    case 6  : strcpy(C2F(cha1).buf,"a block has been called with input out of its domain");
2076              break;
2077
2078    case 7  : strcpy(C2F(cha1).buf,"singularity in a block");
2079              break;
2080
2081    case 8  : strcpy(C2F(cha1).buf,"block produces an internal error");
2082              break;
2083
2084    case 20  : strcpy(C2F(cha1).buf,"initial conditions not converging");
2085               C2F(curblk).kfun=0;
2086               break;
2087
2088    case 21  : sprintf(C2F(cha1).buf, "cannot allocate memory in block=%d", \
2089                      C2F(curblk).kfun);
2090               C2F(curblk).kfun=0;
2091               break;
2092
2093    case 22  : strcpy(C2F(cha1).buf,"sliding mode condition, cannot integrate");
2094               C2F(curblk).kfun=0;
2095               break;
2096
2097    default  : if(ierr>=1000)
2098                 strcpy(C2F(cha1).buf,"unknown or erroneous block");
2099               else if (ierr>=100)
2100               {
2101                istate=-(ierr-100);
2102                sprintf(C2F(cha1).buf, "integration problem istate=%d",istate);
2103                C2F(curblk).kfun=0;
2104               }
2105               else
2106               {
2107                strcpy(C2F(cha1).buf,"scicos unexpected error,please report...");
2108                C2F(curblk).kfun=0;
2109               }
2110               break;
2111   }
2112   if (! (C2F(errgst).err1>0||Err>0))
2113   {
2114    Scierror(888,"%s\n",C2F(cha1).buf);
2115    C2F(curblk).kfun=0;
2116    C2F(com).fun=0; /*set common fun=0 (this disable bug in debug mode)*/
2117    return 0;
2118   }
2119  }
2120
2121  if (Err>0) return 0;
2122
2123  C2F(curblk).kfun=0;
2124  C2F(com).fun=0;
2125
2126  /*********************
2127   * return Lsh variable
2128   *********************/
2129  if (Lhs>=1) LhsVar(1) = 1; /*return state in LhsVar(1)*/
2130  if (Lhs==2) LhsVar(2) = 2; /*return tcur in LhsVar(2)*/
2131
2132  /* end */
2133  return 0;
2134  }
2135
2136 /*-----------------------------------------------------------------
2137  * CopyVarFromlistentry
2138  *    Copy a Scilab object in a list to the variable position  lw
2139  *
2140  * Calling sequence :
2141  *  int CopyVarFromlistentry(int lw, int *header, int i)
2142  *
2143  * Input parameters : lw : integer, the free position
2144  *                    header : integer pointer, a pointer of a list.
2145  *                    i : integer, give the number of the element to copy
2146  *
2147  * Output : FALSE if failed, TRUE else.
2148  *
2149  * Examples of use 
2150  *
2151  * 1 -  put the third element of a list given in position lw=1 
2152  *      to position lw=2 :
2153  *
2154  *  int *il_list;
2155  *  il_list = (int *) Getdata(1);
2156  *  CopyVarFromlistentry(2, il_list, 3)
2157  *
2158  * 2 - put the second element of a list stored in the fourth element 
2159  *     of a list in position lw=1 to position lw=3 :
2160  *
2161  *  int *il_list;
2162  *  il_list = (int *) Getdata(1);
2163  *  int *il_sublist;
2164  *  il_sublist = (int *) listentry(il_list,4);
2165  *  CopyVarFromlistentry(3, il_sublist, 2)
2166  *----------------------------------------------------------------*/
2167
2168 int CopyVarFromlistentry(int lw, int *header, int i)
2169 {
2170    /* Local variablle definition*/
2171    int ret,un=1;
2172    double *l;
2173    int n;
2174
2175    /* Test if we receive a NULL ptr header */
2176    if (header==NULL) return FALSE_;
2177
2178    /* Get the start address of the i element of the input list*/
2179    if ((l = (double *) listentry(header,i))==NULL) return FALSE_;
2180
2181    /* Compute the length of the i element in double word */
2182    n = header[i+2]-header[i+1];
2183
2184    /* Create empty data of a size n*sizeof(double) at the position lw */
2185    if ((ret=C2F(createdata)(&lw, n*sizeof(double)))==FALSE_) return ret;
2186
2187    /* Copy the element i to position lw*/
2188    C2F(unsfdcopy)(&n,l,&un,stk(*Lstk(lw + Top - Rhs)),&un);
2189    return TRUE_; 
2190 }
2191
2192 /* var2sci function to convert an array of scicos
2193  * blocks to scilab object in the Top+1 position 
2194  * in the stack.
2195  *
2196  * Input parameters :
2197  * *x       : void ptr, scicos blocks array to store
2198  *            in the Top+1 position in the stack.
2199  * n        : integer, number of rows.
2200  * m        : integer, number of columns.
2201  * typ_var  : integer, type of scicos data :
2202  *            10  : double real
2203  *            11  : double complex
2204  *            80  : int
2205  *            81  : int8
2206  *            82  : int16
2207  *            84  : int32
2208  *            800 : uint
2209  *            811 : uint8
2210  *            812 : uint16
2211  *            814 : uint32
2212  *
2213  *
2214  * Output parameters : int (<1000), error flag
2215  *                     (0 if no error)
2216  *
2217  * 07/06/06, Alan    : initial version.
2218  *
2219  * 23/06/06, Alan    : moved in intcscicos.c to do
2220  *                     the connection with getscicosvars("blocks")
2221  */
2222
2223 /* prototype */
2224 int var2sci(void *x,int n,int m,int typ_var)
2225 {
2226   /************************************
2227    * variables and constants définition
2228    ************************************/
2229   /*counter and address variable declaration*/
2230   int nm,il,l,j,err;
2231
2232   /*define all type of accepted ptr */
2233   double *x_d,*ptr_d;
2234   char *x_c,*ptr_c;
2235   unsigned char *x_uc,*ptr_uc;
2236   short *x_s,*ptr_s;
2237   unsigned short *x_us,*ptr_us;
2238   int *x_i,*ptr_i;
2239   unsigned int *x_ui,*ptr_ui;
2240   long *x_l,*ptr_l;
2241   unsigned long *x_ul,*ptr_ul;
2242
2243   /* Check if the stack is not full */
2244   if (Top >= Bot) 
2245   {
2246    err = 1;
2247    return err;
2248   }
2249   else
2250   {
2251    Top = Top + 1;
2252    il = iadr(*Lstk(Top));
2253    l = sadr(il+4);
2254   }
2255
2256   /* set number of double needed to store data */
2257   if (typ_var==10) nm=n*m; /*double real matrix*/
2258   else if (typ_var==11)  nm=n*m*2; /*double real matrix*/
2259   else if (typ_var==80)  nm=(int)(ceil((n*m)/2)+1); /*int*/
2260   else if (typ_var==81)  nm=(int)(ceil((n*m)/8)+1); /*int8*/
2261   else if (typ_var==82)  nm=(int)(ceil((n*m)/4)+1); /*int16*/
2262   else if (typ_var==84)  nm=(int)(ceil((n*m)/2)+1); /*int32*/
2263   else if (typ_var==800) nm=(int)(ceil((n*m)/2)+1); /*uint*/
2264   else if (typ_var==811) nm=(int)(ceil((n*m)/8)+1); /*uint8*/
2265   else if (typ_var==812) nm=(int)(ceil((n*m)/4)+1); /*uint16*/
2266   else if (typ_var==814) nm=(int)(ceil((n*m)/2)+1); /*uint32*/
2267   else nm=n*m; /*double real matrix*/
2268
2269   /*check if there is free space for new data*/
2270   err = l + nm - *Lstk(Bot);
2271   if (err > 0) 
2272   {
2273    err = 2;
2274    return err;
2275   }
2276
2277   /**************************
2278    * store data on the stack
2279    *************************/
2280   switch (typ_var) /*for each type of data*/
2281   {
2282        case 10  : /* set header */
2283                   *istk(il) = 1; /*double real matrix*/
2284                   *istk(il+1) = n;
2285                   *istk(il+2) = m;
2286                   *istk(il+3) = 0;
2287                   x_d = (double *) x;
2288                   ptr_d = (double *) stk(l);
2289                   for (j=0;j<m*n;j++) ptr_d[j] = x_d[j];
2290                   break;
2291
2292        case 11  : /* set header */
2293                   *istk(il) = 1; /*double complex matrix*/
2294                   *istk(il+1) = n;
2295                   *istk(il+2) = m;
2296                   *istk(il+3) = 1;
2297                   x_d = (double *) x;
2298                   ptr_d = (double *) stk(l);
2299                   for (j=0;j<2*m*n;j++) ptr_d[j] = x_d[j];
2300                   break;
2301
2302        case 80  : /* set header */
2303                   *istk(il) = 8; /*int*/
2304                   *istk(il+1) = n;
2305                   *istk(il+2) = m;
2306                   *istk(il+3) = 4;
2307                   x_i = (int *) x;
2308                   for (j=0;j<m*n;j++)
2309                   {
2310                    ptr_i = (int *) istk(il+4);
2311                    ptr_i[j] = x_i[j];
2312                   }
2313                   break;
2314
2315        case 81  : /* set header */
2316                   *istk(il) = 8; /*int8*/
2317                   *istk(il+1) = n;
2318                   *istk(il+2) = m;
2319                   *istk(il+3) = 1;
2320                   x_c = (char *) x;
2321                   for (j=0;j<m*n;j++)
2322                   {
2323                    ptr_c = (char *) istk(il+4);
2324                    ptr_c[j] = x_c[j];
2325                   }
2326                   break;
2327
2328        case 82  : /* set header */
2329                   *istk(il) = 8; /*int16*/
2330                   *istk(il+1) = n;
2331                   *istk(il+2) = m;
2332                   *istk(il+3) = 2;
2333                   x_s = (short *) x;
2334                   for (j=0;j<m*n;j++)
2335                   {
2336                    ptr_s = (short *) istk(il+4);
2337                    ptr_s[j] = x_s[j];
2338                   }
2339                   break;
2340
2341        case 84  : /* set header */
2342                   *istk(il) = 8; /*int32*/
2343                   *istk(il+1) = n;
2344                   *istk(il+2) = m;
2345                   *istk(il+3) = 4;
2346                   x_l = (long *) x;
2347                   for (j=0;j<m*n;j++)
2348                   {
2349                    ptr_l = (long *) istk(il+4);
2350                    ptr_l[j] = x_l[j];
2351                   }
2352                   break;
2353
2354        case 800 : /* set header */
2355                   *istk(il) = 8; /*uint*/
2356                   *istk(il+1) = n;
2357                   *istk(il+2) = m;
2358                   *istk(il+3) = 14;
2359                   x_ui = (unsigned int *) x;
2360                   for (j=0;j<m*n;j++)
2361                   {
2362                    ptr_ui = (unsigned int *) istk(il+4);
2363                    ptr_ui[j] = x_ui[j];
2364                   }
2365                   break;
2366
2367        case 811 : /* set header */
2368                   *istk(il) = 8; /*uint8*/
2369                   *istk(il+1) = n;
2370                   *istk(il+2) = m;
2371                   *istk(il+3) = 11;
2372                   x_uc = (unsigned char *) x;
2373                   for (j=0;j<m*n;j++)
2374                   {
2375                    ptr_uc = (unsigned char *) istk(il+4);
2376                    ptr_uc[j] = x_uc[j];
2377                   }
2378                   break;
2379
2380        case 812 : /* set header */
2381                   *istk(il) = 8; /*uint16*/
2382                   *istk(il+1) = n;
2383                   *istk(il+2) = m;
2384                   *istk(il+3) = 12;
2385                   x_us = (unsigned short *) x;
2386                   for (j=0;j<m*n;j++)
2387                   {
2388                    ptr_us = (unsigned short *) istk(il+4);
2389                    ptr_us[j] = x_us[j];
2390                   }
2391                   break;
2392
2393        case 814 : /* set header */
2394                   *istk(il) = 8; /*uint32*/
2395                   *istk(il+1) = n;
2396                   *istk(il+2) = m;
2397                   *istk(il+3) = 14;
2398                   x_ul = (unsigned long *) x;
2399                   for (j=0;j<m*n;j++)
2400                   {
2401                    ptr_ul = (unsigned long *) istk(il+4);
2402                    ptr_ul[j] = x_ul[j];
2403                   }
2404                   break;
2405
2406        default  : /* set header */
2407                   *istk(il) = 1; /*double real matrix*/
2408                   *istk(il+1) = n;
2409                   *istk(il+2) = m;
2410                   *istk(il+3) = 0;
2411                   x_d = (double *) x;
2412                   for (j=0;j<m*n;j++)
2413                   {
2414                    ptr_d = (double *) stk(il+4);
2415                    ptr_d[j] = x_d[j];
2416                   }
2417                   break;
2418   }
2419
2420   /* set value in lstk */
2421   *Lstk(Top+1) = l + nm;
2422
2423   /*return error flag = 0 */
2424   err = 0;
2425   return 0;
2426 }
2427
2428 /* createblklist : function to create a Typed List
2429  *                 of a scicos_block structure
2430  *                 at the top+1 postion of the stack
2431  *
2432  * needs/depends : var2sci, C2F(mklist), C2F(mtklist),
2433  *                 vvtosci, string.h, C2F(scierr), str2sci
2434  *
2435  * input argument : Blocks :scicos_block  ptr on a scicos_block structure
2436  *                  ierr : int ptr, an error flag
2437  *                  flag_imp : if flag_imp>=0 then use
2438  *                             import structure for x, xd and g.
2439  *                             In this case flag_imp is the block number.
2440  *
2441  * output argument : return 0 if failed, 1 else.
2442  *
2443  *
2444  * 23/06/06, Alan : extracted from sciblk4 to be used
2445  *                  in intgetscicosvars
2446  *
2447  * 26/06/06, Alan : Add flag_imp in input arguments.
2448  *                  This is done to disable scilab crash with getscicosvars("blocks")
2449  *                  because when calling at the beginning of the simulation, x, xd and 
2450  *                  g are not yet informed for all blocks with nx!=0 and ng!=0.
2451  *                  (They are not yed called with callf in scicos.c)
2452  *
2453  */
2454
2455 /*prototype*/
2456 int createblklist(scicos_block *Blocks, int *ierr, int flag_imp)
2457 {
2458   /*local variable declaration*/
2459   int k;
2460   int nu,mu,ny,my;
2461   int u_typ,y_typ;
2462
2463   /*variable used when imp_flag>=0*/
2464   int nv,mv;          /* length of data                                        */
2465   int nblk,ng;        /* to store number of blocks and number of zero cross.   */
2466   void *ptr;          /* ptr for data comming from import structure            */
2467   int *ptr_int;       /* ptr to store ptr on integer                           */
2468   double *ptr_double; /* ptr to store ptr on double                            */
2469   int *xptr, *zcptr;  /* to retrieve xptr by import and zcptr of scicos_blocks */
2470   double *x,*xd,*g;   /* ptr for x, xd and g for scicos_blocks              */
2471
2472   /* set length of block list -please update me-                           */
2473   static int nblklst=31;
2474   /* set string of first element of scilab Blocks tlist -please update me- */
2475   static char *str_blklst[]={ "scicos_block", "nevprt" , "funpt" , "type"  ,
2476                               "scsptr"      , "nz"     , "z"     , "nx"    ,
2477                               "x"           , "xd"     , "res"   , "nin"   ,
2478                               "insz"        , "inptr"  , "nout"  , "outsz" ,
2479                               "outptr"      , "nevout" , "evout" , "nrpar" ,
2480                               "rpar"        , "nipar"  , "ipar"  , "ng"    ,
2481                               "g"           , "ztyp"   , "jroot" , "label" ,
2482                               "work"        , "nmode"  , "mode"};
2483
2484   /* char ptr for str2sci - see below - */
2485   char **str1;
2486
2487
2488   /* set nblk, x, xd ptr coming from import strucuture,
2489    * if flag_imp >=0
2490    */
2491   if (flag_imp>=0)
2492   {
2493    /*retrieve nblk by import structure*/
2494    strcpy(C2F(cha1).buf,"nblk");
2495    *ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
2496    if (*ierr==0) return 0;
2497    ptr_int = (int *) ptr;
2498    nblk = *ptr_int;
2499
2500    /* retrieve ng by import structure */
2501    strcpy(C2F(cha1).buf,"ng");
2502    *ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
2503    ptr_int = (int *) ptr; /* cast void* ptr to int* ptr */
2504    ng = *ptr_int;
2505
2506    /*retrieve xptr by import structure*/
2507    strcpy(C2F(cha1).buf,"xptr");
2508    *ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
2509    if (*ierr==0) return 0;
2510    ptr_int = (int *) ptr;
2511    xptr = ptr_int;
2512
2513    /*retrieve zcptr by import structure*/
2514    strcpy(C2F(cha1).buf,"zcptr");
2515    *ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
2516    ptr_int = (int *) ptr;
2517    zcptr = ptr_int;
2518
2519    /*retrieve x and xd by import structure*/
2520    strcpy(C2F(cha1).buf,"x");
2521    *ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
2522    if (*ierr==0) return 0;
2523    ptr_double = (double *) ptr;
2524    x = ptr_double;
2525    xd = &x[xptr[nblk]-1];
2526
2527    /*retrieve g by import structure*/
2528    strcpy(C2F(cha1).buf,"g");
2529    *ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
2530    ptr_double = (double *) ptr;
2531    g = ptr_double;
2532   }
2533
2534   /****************************
2535    * create scilab tlist Blocks
2536    ****************************/
2537   /* 1 - scicos_block */
2538   str2sci(str_blklst,1,31);
2539
2540   /* 2 - nevprt */
2541   *ierr=var2sci(&Blocks[0].nevprt,1,1,80);
2542   if (*ierr!=0) return 0;
2543
2544   /* 3 - funpt */
2545   *ierr=var2sci(&Blocks[0].funpt,0,1,80); /* !!!! */
2546   if (*ierr!=0) return 0;
2547
2548   /* 4 - type */
2549   *ierr=var2sci(&Blocks[0].type,1,1,80); /* !!!! */
2550   if (*ierr!=0) return 0;
2551
2552   /* 5 - scsptr */
2553   *ierr=var2sci(&Blocks[0].scsptr,0,1,80); /* !!!! */
2554   if (*ierr!=0) return 0;
2555
2556   /* 6 - nz */
2557   *ierr=var2sci(&Blocks[0].nz,1,1,80);
2558   if (*ierr!=0) return 0;
2559
2560   /* 7 - z */
2561   if(Blocks[0].scsptr>0)
2562   {
2563    C2F(vvtosci)(Blocks[0].z,&Blocks[0].nz);
2564    if (C2F(scierr)()!=0) return 0; 
2565   }
2566   else
2567   {
2568    *ierr=var2sci(Blocks[0].z,Blocks[0].nz,1,10);
2569    if (*ierr!=0) return 0; 
2570   }
2571
2572   /* 8 - nx */
2573   *ierr=var2sci(&Blocks[0].nx,1,1,80);
2574   if (*ierr!=0) return 0;
2575
2576   /* 9 - x */
2577   if (flag_imp>=0) *ierr=var2sci(&x[xptr[flag_imp]-1],Blocks[0].nx,1,10);
2578   else *ierr=var2sci(Blocks[0].x,Blocks[0].nx,1,10);
2579   if (*ierr!=0) return 0; 
2580
2581   /* 10 - xd */
2582   if (flag_imp>=0) *ierr=var2sci(&xd[xptr[flag_imp]-1],Blocks[0].nx,1,10);
2583   else *ierr=var2sci(Blocks[0].xd,Blocks[0].nx,1,10);
2584   if (*ierr!=0) return 0; 
2585
2586   /* 11 - res */
2587   *ierr=var2sci(Blocks[0].res,Blocks[0].nx,1,10);
2588   if (*ierr!=0) return 0;
2589
2590   /* 12 - nin */
2591   *ierr=var2sci(&Blocks[0].nin,1,1,80);
2592   if (*ierr!=0) return 0;
2593
2594   /* 13 - insz */
2595   *ierr=var2sci(Blocks[0].insz,3*Blocks[0].nin,1,80);
2596   if (*ierr!=0) return 0;
2597
2598   /* 14 - inptr */
2599   for (k=0;k<Blocks[0].nin;k++) 
2600   {
2601    nu=Blocks[0].insz[k]; /* retrieve number of rows */
2602    mu=Blocks[0].insz[Blocks[0].nin+k]; /* retrieve number of cols */
2603    u_typ=Blocks[0].insz[2*Blocks[0].nin+k]; /* retrieve type */
2604    *ierr=var2sci(Blocks[0].inptr[k],nu,mu,u_typ);
2605    if (*ierr!=0) return 0;
2606   }
2607   C2F(mklist)(&Blocks[0].nin); /*create inptr list*/
2608
2609   /* 15 - nout */
2610   *ierr=var2sci(&Blocks[0].nout,1,1,80);
2611   if (*ierr!=0) return 0;
2612
2613   /* 16 - outsz */
2614   *ierr=var2sci(Blocks[0].outsz,3*Blocks[0].nout,1,80);
2615   if (*ierr!=0) return 0;
2616
2617   /* 17 - outptr */
2618   for (k=0;k<Blocks[0].nout;k++) 
2619   {
2620    ny=Blocks[0].outsz[k]; /* retrieve number of rows */
2621    my=Blocks[0].outsz[Blocks[0].nout+k]; /* retrieve number of cols */
2622    y_typ=Blocks[0].outsz[2*Blocks[0].nout+k]; /* retrieve type */
2623    *ierr=var2sci(Blocks[0].outptr[k],ny,my,y_typ);
2624    if (*ierr!=0) return 0;
2625   }
2626   C2F(mklist)(&Blocks[0].nout); /*create outptr list*/
2627
2628   /* 18 - nevout */
2629   *ierr=var2sci(&Blocks[0].nevout,1,1,80);
2630   if (*ierr!=0) return 0;
2631
2632   /* 19 - evout */
2633   *ierr=var2sci(Blocks[0].evout,Blocks[0].nevout,1,10);
2634   if (*ierr!=0) return 0; 
2635
2636   /* 20 - nrpar */
2637   *ierr=var2sci(&Blocks[0].nrpar,1,1,80);
2638   if (*ierr!=0) return 0;
2639
2640   /* 21 - rpar */
2641   if(Blocks[0].scsptr>0)
2642   {
2643    C2F(vvtosci)(Blocks[0].rpar,&Blocks[0].nrpar);
2644    if (C2F(scierr)()!=0) return 0;
2645   }
2646   else
2647   {
2648    *ierr=var2sci(Blocks[0].rpar,Blocks[0].nrpar,1,10);
2649    if (*ierr!=0) return 0; 
2650   }
2651
2652   /* 22 - nipar */
2653   *ierr=var2sci(&Blocks[0].nipar,1,1,80);
2654   if (*ierr!=0) return 0;
2655
2656   /* 23 - ipar */
2657   *ierr=var2sci(Blocks[0].ipar,Blocks[0].nipar,1,80);
2658   if (*ierr!=0) return 0;
2659
2660   /* 24 - ng */
2661   *ierr=var2sci(&Blocks[0].ng,1,1,80);
2662   if (*ierr!=0) return 0;
2663
2664   /* 25 - g */
2665   if (flag_imp>=0) *ierr=var2sci(&g[zcptr[flag_imp]-1],Blocks[0].ng,1,10);
2666   else *ierr=var2sci(Blocks[0].g,Blocks[0].ng,1,10);
2667   if (*ierr!=0) return 0;
2668
2669   /* 26 - ztyp */
2670   *ierr=var2sci(&Blocks[0].ztyp,1,1,80);
2671   if (*ierr!=0) return 0;
2672
2673   /* 27 - jroot */
2674   *ierr=var2sci(Blocks[0].jroot,Blocks[0].ng,1,80);
2675   if (*ierr!=0) return 0;
2676
2677   /* 28 - label */
2678   if ((str1=MALLOC(sizeof(char*))) ==NULL )  return 0;
2679   if ((str1[0]=MALLOC(sizeof(char)*(strlen(Blocks[0].label)+1))) ==NULL )  return 0;
2680   (str1[0])[strlen(Blocks[0].label)]='\0';
2681   strncpy(str1[0],Blocks[0].label,strlen(Blocks[0].label));
2682   str2sci(str1,1,1);
2683   FREE(str1[0]);
2684   FREE(str1);
2685   if (C2F(scierr)()!=0) return 0; 
2686
2687   /* 29 - work*/
2688   C2F(vvtosci)(*Blocks[0].work,(k=0,&k));
2689   if (C2F(scierr)()!=0) return 0; 
2690
2691   /* 30 - nmode*/
2692   *ierr=var2sci(&Blocks[0].nmode,1,1,80);
2693   if (*ierr!=0) return 0;
2694
2695   /* 31 - mode */
2696   *ierr=var2sci(Blocks[0].mode,Blocks[0].nmode,1,80);
2697   if (*ierr!=0) return 0;
2698
2699   C2F(mktlist)(&nblklst); /*create Blocks list*/
2700   if (C2F(scierr)()!=0) return 0;
2701
2702   /*return 1 if succeeded */
2703   return 1;
2704 }
2705
2706 /* intgetscicosvarsc getscicosvars interface routine
2707  * retrieve some informations during simulation.
2708  *
2709  * [myvar]=getscicosvars(str)
2710  *
2711  * rhs 1  : str : a character string matrix with choice,
2712  *               - 'x' to retrieve continuous state
2713  *               - 'xptr' to retrieve ptr of continuous state
2714  *               - 'z' to retrieve discrete state
2715  *               - 'zptr' to retrieve ptr of discrete state
2716  *               - 'rpar' to retrieve real parameters
2717  *               - 'rpptr' to retrieve ptr of real parameters
2718  *               - 'ipar' to retrieve integer parameters
2719  *               - 'ipptr' to retrieve  ptr of integer parameters
2720  *               - 'outtb' to retrieve output register (list of scilb object)
2721  *               - 'inpptr' to retrieve number of input ports
2722  *               - 'outptr' to retrieve number of output ports
2723  *               - 'inplnk' to retrieve link number of input ports
2724  *               - 'outlnk' to retrieve link number of output ports
2725  *               ...... -see below-
2726  *
2727  * lhs 1  : myvar : matrix of int32 or double, or list or a Tlist
2728  *
2729  * 31/05/06, Alan : Rewritten from original fortran
2730  * source code intgetscicosvars in coselm.f.
2731  *
2732  * 22/06/06, Alan : Allow multiple string in rhs(1).
2733  *                  Create Tlist for Lhs(1).
2734  *
2735  * 23/06/06, Alan : Create blocks list for Lhs(1).
2736  *
2737  */
2738
2739 int intgetscicosvarsc(fname,fname_len)
2740                  char *fname;
2741                  unsigned long fname_len;
2742 {
2743   /************************************
2744    * variables and constants définition
2745    ************************************/
2746   /* auxilary variables for dimension and address */
2747   int m1,n1;     /* dimension of input character string               */
2748   int *il_str;   /* address of the description of the input parameter */
2749   int *l_str;    /* address of the data of the input parameter        */
2750   int l_tmp;     /* temp variables to store address                   */
2751   int *il_tmp;
2752
2753   /* definition of min/max input/output argument */
2754   static int minrhs=0, maxrhs=1;
2755
2756   /* auxilary variables */
2757   int nv,mv;                /* length of data                                      */
2758   void *ptr;                /* ptr for data comming from import structure          */
2759   int *ptr_int;             /* ptr to store ptr on integer                         */
2760   double *ptr_dd;           /* ptr to store ptr on double                          */
2761   scicos_block *ptr_scsblk; /* ptr to store ptr of scicos_block structure          */
2762   outtb_el *ptr_elem;       /* ptr to store ptr of outtb_el structure              */
2763   int nblk,ng;              /* to store number of blocks and number of zero cross. */
2764   int *xptr, *zcptr;        /* to store xptr and zcptr of scicos_blocks            */
2765   double *x,*xd,*g;         /* ptr for x, xd and g for scicos_blocks               */
2766
2767   int ierr;       /* error flag                                */
2768   int errc;       /* error flag for ceateblklst                */
2769   int ptr_pos;    /* to store position in scilab string object */
2770   int Topsave;    /* to save the Top position                  */
2771
2772   int sz_str;     /* local variabe to store size of string */
2773   int i,j,k;      /* local counter variable                */
2774
2775   /* number of entries -please update me-                        */
2776   static int nentries=60;
2777   /* define accepted entries of getscicosvars -please update me- */
2778   static char *entry[]={ "x"        , "nx"      , "xptr"     , "zcptr"  , "z"      ,
2779                          "nz"       , "zptr"    , "rpar"     , "rpptr"  , "ipar"   ,
2780                          "ipptr"    , "outtb"   , "inpptr"   , "outptr" , "inplnk" ,
2781                          "outlnk"   , "subs"    , "tevts"    , "evtspt" , "pointi" ,
2782                          "iord"     , "oord"    , "zord"     , "funtyp" , "ztyp"   ,
2783                          "cord"     , "ordclk"  , "clkptr"   , "ordptr" , "critev" ,
2784                          "mod"      , "nmod"    , "iz"       , "nblk"   , "izptr"  ,
2785                          "outtbptr" , "outtbsz" , "outtbtyp" , "nlnk"   , "nsubs"  ,
2786                          "nevts"    , "niord"   , "noord"    , "nzord"  , "funptr" ,
2787                          "ncord"    , "nordptr" , "iwa"      , "blocks" , "ng"     ,
2788                          "g"        , "t0"      , "tf"       , "Atol"   , "rtol"   ,
2789                          "ttol"     , "deltat"  , "hmax"     , "nelem"  , "outtb_elem"};
2790
2791   char **dyn_char; /* for allocation of first entry in tlist */
2792
2793   /****************************************
2794    * Check number of inputs and outputs Rhs
2795    ****************************************/
2796   CheckRhs(minrhs,maxrhs);
2797
2798   /* Display usage of getscicosvars function if Rhs==0 */
2799   if (Rhs==0)
2800   {
2801    sciprint("\ngetscicosvars : utility function to retrieve\n" 
2802             "                scicos arrays during simulation.\n\n"
2803             "Usage : [myvar]=getscicosvars([\"str1\";\"str2\";...]);\n\n"
2804             "- myvar : an int32 or double matrix or a Tlist.\n"
2805             "- [\"str1\";\"str2\",...] is a string matrix\n"
2806             "  that must be informed with the following values :\n");
2807
2808    /* display allowed entries */
2809    i=0;
2810    for (j=0;j<nentries;j++)
2811    {
2812     if (j==nentries-1) sciprint("\"%s\" ",entry[j]);
2813     else sciprint("\"%s\", ",entry[j]);
2814     i++;
2815     if (i==6) {sciprint("\n");i=0;}
2816    }
2817    sciprint("\n");
2818    return 0;
2819   }
2820
2821   /*******************
2822    * Check str (rhs 1)
2823    *******************/
2824   il_str = (int *) GetData(1); /* get ptr of integer header of rsh 1 */
2825   if(il_str[0]!=10) /* Check if input argument is a character string matrix */
2826   {
2827    Scierror(55,"%s : First argument must be a string.\n",fname);
2828    Err=1;
2829    return 0;
2830   }
2831
2832   /*retrieve dimension of input string matrix*/
2833   m1 = il_str[1]; /* number of row    */
2834   n1 = il_str[2]; /* number of column */
2835
2836   /*Create header of Tlist*/
2837   if ((dyn_char=MALLOC((1+m1*n1)*sizeof(char *)))==NULL)
2838   {
2839    Scierror(999,"%s : No more memory.\n",fname);
2840    return 0;
2841   }
2842
2843   /* Type of list is scicosvar */
2844   if ((dyn_char[0]=MALLOC((strlen("scicosvar")+1)*sizeof(char)))==NULL)
2845   {
2846    FREE(dyn_char);
2847    Scierror(999,"%s : No more memory.\n",fname);
2848    return 0;
2849   }
2850   else strcpy(dyn_char[0],"scicosvar");
2851
2852   /*Check string matrix  */
2853   for (j=0;j<m1*n1;j++)
2854   {
2855     sz_str = il_str[5+j]-il_str[4+j]; /* store the length of str */
2856     /*get current position in the istk*/
2857     if (j==0)
2858       ptr_pos=5+m1*n1; 
2859     else
2860       ptr_pos += il_str[5+j-1]-il_str[4+j-1];
2861     l_str = &il_str[ptr_pos]; /* get ptr of rsh 1 */
2862     /* codetoascii convertion */
2863     C2F(cha1).buf[0]=' ';
2864     C2F(cvstr)(&sz_str,&l_str[0],&C2F(cha1).buf[0],(i=1,&i),sz_str);
2865     C2F(cha1).buf[sz_str]='\0';
2866     /* search if string is in accordance with entry*/
2867     ierr=TRUE_;
2868     for (i=0;i<nentries;i++)
2869     {
2870      if (strcmp(C2F(cha1).buf,entry[i]) == 0) 
2871      {
2872       /* Store string in header of Tlist */
2873       if ((dyn_char[j+1]=MALLOC(sizeof(char)*strlen(entry[i])+1))==NULL)
2874       {
2875        FREE(dyn_char);
2876        Scierror(999,"%s : No more memory.\n",fname);
2877        return 0;
2878       }
2879       else strcpy(dyn_char[j+1],entry[i]);
2880
2881       ierr=FALSE_;
2882       break;
2883      }
2884     }
2885     /* if failed then display an error message and exit*/
2886     if (ierr==TRUE_)
2887     {
2888      FREE(dyn_char);
2889      Scierror(999,"%s : Undefined field in string matrix position : %d.\n",fname,j+1);
2890      return 0;
2891     }
2892   }
2893
2894   /* store dyn_char on stack*/
2895   if (n1*m1>1) str2sci(dyn_char,1,n1*m1+1);
2896
2897   /* return asked array */
2898   for (j=0;j<m1*n1;j++)
2899   {
2900    sz_str = il_str[5+j]-il_str[4+j]; /* store the length of str */
2901    /*get current position in the istk of the string*/
2902    if (j==0)
2903      ptr_pos=5+m1*n1; 
2904    else
2905      ptr_pos += il_str[5+j-1]-il_str[4+j-1];
2906    l_str = &il_str[ptr_pos]; /* get ptr of rsh 1 */
2907    /* codetoascii convertion */
2908    C2F(cha1).buf[0]=' ';
2909    C2F(cvstr)(&sz_str,&l_str[0],&C2F(cha1).buf[0],(i=1,&i),sz_str);
2910    C2F(cha1).buf[sz_str]='\0';
2911
2912    /*****************************************************************************
2913     * entries that can be retrieve by il_state_save, il_sim_save global variable
2914     *****************************************************************************/
2915    if (strcmp(C2F(cha1).buf,"x") == 0)          /* retrieve continuous state */
2916     ierr=CopyVarFromlistentry(j+2,il_state_save,2);
2917    else if (strcmp(C2F(cha1).buf,"xptr") == 0)  /* retrieve ptr of continuous state */
2918     ierr=CopyVarFromlistentry(j+2,il_sim_save,3);
2919    else if (strcmp(C2F(cha1).buf,"zcptr") == 0)  /* retrieve ptr of zero crossing array */
2920     ierr=CopyVarFromlistentry(j+2,il_sim_save,5);
2921    else if (strcmp(C2F(cha1).buf,"z") == 0)      /* retrieve discrete state */
2922     ierr=CopyVarFromlistentry(j+2,il_state_save,3);
2923    else if (strcmp(C2F(cha1).buf,"zptr") == 0)   /* retrieve ptr of discrete state */
2924     ierr=CopyVarFromlistentry(j+2,il_sim_save,4);
2925    else if (strcmp(C2F(cha1).buf,"rpar") == 0)   /* retrieve rpar */
2926     ierr=CopyVarFromlistentry(j+2,il_sim_save,10);
2927    else if (strcmp(C2F(cha1).buf,"rpptr") == 0)  /* retrieve ptr of rpar */
2928     ierr=CopyVarFromlistentry(j+2,il_sim_save,11);
2929    else if (strcmp(C2F(cha1).buf,"ipar") == 0)   /* retrieve ipar */
2930     ierr=CopyVarFromlistentry(j+2,il_sim_save,12);
2931    else if (strcmp(C2F(cha1).buf,"ipptr") == 0)  /* retrieve ptr of ipar */
2932     ierr=CopyVarFromlistentry(j+2,il_sim_save,13);
2933    else if (strcmp(C2F(cha1).buf,"outtb") == 0)  /* retrieve outtb */
2934     ierr=CopyVarFromlistentry(j+2,il_state_save,8);
2935    else if (strcmp(C2F(cha1).buf,"inpptr") == 0) /* retrieve number of input ports */
2936     ierr=CopyVarFromlistentry(j+2,il_sim_save,6);
2937    else if (strcmp(C2F(cha1).buf,"outptr") == 0) /* retrieve number of output ports */
2938     ierr=CopyVarFromlistentry(j+2,il_sim_save,7);
2939    else if (strcmp(C2F(cha1).buf,"inplnk") == 0) /* retrieve link number of input ports */
2940     ierr=CopyVarFromlistentry(j+2,il_sim_save,8);
2941    else if (strcmp(C2F(cha1).buf,"outlnk") == 0) /* retrieve link number of output ports */
2942     ierr=CopyVarFromlistentry(j+2,il_sim_save,9);
2943    else if (strcmp(C2F(cha1).buf,"subs") == 0)   /* retrieve subscr */
2944     ierr=CopyVarFromlistentry(j+2,il_sim_save,26);
2945    else if (strcmp(C2F(cha1).buf,"tevts") == 0)  /* retrieve tevts */
2946     ierr=CopyVarFromlistentry(j+2,il_state_save,5);
2947    else if (strcmp(C2F(cha1).buf,"evtspt") == 0) /* retrieve evtspt */
2948     ierr=CopyVarFromlistentry(j+2,il_state_save,6);
2949    else if (strcmp(C2F(cha1).buf,"pointi") == 0) /* retrieve pointi */
2950     ierr=CopyVarFromlistentry(j+2,il_state_save,7);
2951    else if (strcmp(C2F(cha1).buf,"iord") == 0)   /* retrieve iord */
2952     ierr=CopyVarFromlistentry(j+2,il_sim_save,28);
2953    else if (strcmp(C2F(cha1).buf,"oord") == 0)   /* retrieve oord */
2954     ierr=CopyVarFromlistentry(j+2,il_sim_save,19);
2955    else if (strcmp(C2F(cha1).buf,"zord") == 0)   /* retrieve zord */
2956     ierr=CopyVarFromlistentry(j+2,il_sim_save,20);
2957    else if (strcmp(C2F(cha1).buf,"funtyp") == 0) /* retrieve funtyp */
2958     ierr=CopyVarFromlistentry(j+2,il_sim_save,27);
2959    else if (strcmp(C2F(cha1).buf,"ztyp") == 0)   /* retrieve ztyp */
2960     ierr=CopyVarFromlistentry(j+2,il_sim_save,23);
2961    else if (strcmp(C2F(cha1).buf,"cord") == 0)   /* retrieve cord */
2962     ierr=CopyVarFromlistentry(j+2,il_sim_save,18);
2963    else if (strcmp(C2F(cha1).buf,"ordclk") == 0) /* retrieve ordclk */
2964     ierr=CopyVarFromlistentry(j+2,il_sim_save,17);
2965    else if (strcmp(C2F(cha1).buf,"clkptr") == 0) /* retrieve clkptr */
2966     ierr=CopyVarFromlistentry(j+2,il_sim_save,14);
2967    else if (strcmp(C2F(cha1).buf,"ordptr") == 0) /* retrieve ordptr */
2968     ierr=CopyVarFromlistentry(j+2,il_sim_save,15);
2969    else if (strcmp(C2F(cha1).buf,"critev") == 0) /* retrieve critev */
2970     ierr=CopyVarFromlistentry(j+2,il_sim_save,21);
2971
2972    /*************************************************
2973     * integer variables coming from import structure
2974     *************************************************/
2975    else if ((strcmp(C2F(cha1).buf,"mod") == 0)      || /* retrieve mode */
2976             (strcmp(C2F(cha1).buf,"nmod") == 0)     || /* retrieve nmode */
2977             (strcmp(C2F(cha1).buf,"iz") == 0)       || /* label integer code of blocks */
2978             (strcmp(C2F(cha1).buf,"nblk") == 0)     || /* number of block */
2979             (strcmp(C2F(cha1).buf,"izptr") == 0)    || /* label integer code of blocks ptr*/
2980             (strcmp(C2F(cha1).buf,"outtbptr") == 0) || /* outtb ptr */
2981             (strcmp(C2F(cha1).buf,"outtbsz") == 0)  || /* outtb size */
2982             (strcmp(C2F(cha1).buf,"outtbtyp") == 0) || /* outtb type */
2983             (strcmp(C2F(cha1).buf,"nlnk") == 0)     || /* number of link */
2984             (strcmp(C2F(cha1).buf,"nsubs") == 0)    || /* length of nsubs */
2985             (strcmp(C2F(cha1).buf,"nevts") == 0)    || /* length of evtspt & tevts */
2986             (strcmp(C2F(cha1).buf,"niord") == 0)    || /* length of iord */
2987             (strcmp(C2F(cha1).buf,"noord") == 0)    || /* length of oord */
2988             (strcmp(C2F(cha1).buf,"nzord") == 0)    || /* length of zord */
2989             (strcmp(C2F(cha1).buf,"funptr") == 0)   || /* retrieve function ptr */
2990             (strcmp(C2F(cha1).buf,"ncord") == 0)    || /* retrieve ncord */
2991             (strcmp(C2F(cha1).buf,"nordptr") == 0)  || /* retrieve nordptr */
2992             (strcmp(C2F(cha1).buf,"iwa") == 0)      || /* retrieve iwa */
2993             (strcmp(C2F(cha1).buf,"ng") == 0)       || /* retrieve ng */
2994             (strcmp(C2F(cha1).buf,"nx") == 0)       || /* retrieve nx */
2995             (strcmp(C2F(cha1).buf,"nz") == 0)       || /* retrieve nz */
2996             (strcmp(C2F(cha1).buf,"nelem") == 0)          /* retrieve nelem */
2997                                                      )
2998    {
2999     /* retrieve dims and prt of asked array with getscicosvarsfromimport */
3000     ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
3001
3002     /* check ierr flag */
3003     if (ierr==TRUE_)
3004     {
3005      l_tmp = I_INT32; /* define type of integer */
3006      CreateVar(j+2,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&nv,&mv,&l_tmp); /* Create int32 variable at the top+j+1 addr. of the stack */
3007      il_tmp = (int *) istk(l_tmp);      /* Store value of address of istk(l_tmp) in il_tmp */
3008      ptr_int = (int *) ptr;             /* cast void* ptr to int* ptr */
3009      for (i=0;i<nv*mv;i++) il_tmp[i] = ptr_int[i]; /* copy returned array in istk */
3010     }
3011    }
3012
3013   /*************************************************
3014    * double variables coming from import structure
3015    *************************************************/
3016    else if ((strcmp(C2F(cha1).buf,"g") == 0)      || /* retrieve g      */
3017             (strcmp(C2F(cha1).buf,"t0") == 0)     || /* retrieve t0     */
3018             (strcmp(C2F(cha1).buf,"tf") == 0)     || /* retrieve tf     */
3019             (strcmp(C2F(cha1).buf,"Atol") == 0)   || /* retrieve Atol   */
3020             (strcmp(C2F(cha1).buf,"rtol") == 0)   || /* retrieve rtol   */
3021             (strcmp(C2F(cha1).buf,"ttol") == 0)   || /* retrieve ttol   */
3022             (strcmp(C2F(cha1).buf,"deltat") == 0) || /* retrieve deltat */
3023             (strcmp(C2F(cha1).buf,"hmax") == 0)   /* retrieve hmax   */
3024                                                  )
3025    {
3026     /* retrieve dims and prt of asked array with getscicosvarsfromimport */
3027     ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
3028
3029     /* check ierr flag */
3030     if (ierr==TRUE_)
3031     {
3032      ptr_dd = (double *) ptr;
3033      CreateVar(j+2,MATRIX_OF_DOUBLE_DATATYPE,&nv,&mv,&l_tmp); /* Create double variable at the top+j+1 addr. of the stack */
3034      for (i=0;i<nv*mv;i++) *stk(l_tmp+i) = ptr_dd[i]; /* copy returned array in istk */
3035     }
3036    }
3037
3038    /*************************************************
3039     * scicos_block ptr coming from import structure
3040     *************************************************/
3041    else if ((strcmp(C2F(cha1).buf,"blocks") == 0)
3042                                                 )
3043    {
3044     /* retrieve scicos_block prt of asked array with getscicosvarsfromimport */
3045     ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
3046
3047     /* check ierr flag */
3048     if (ierr==TRUE_)
3049     {
3050      /* store ptr in ptrscs_blk */
3051      ptr_scsblk = (scicos_block *) ptr;
3052
3053      /* retrieve nblk by import structure */
3054      strcpy(C2F(cha1).buf,"nblk");
3055      ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
3056      ptr_int = (int *) ptr; /* cast void* ptr to int* ptr */
3057      nblk = *ptr_int;
3058
3059      /* retrieve ng by import structure */
3060      strcpy(C2F(cha1).buf,"ng");
3061      ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
3062      ptr_int = (int *) ptr; /* cast void* ptr to int* ptr */
3063      ng = *ptr_int;
3064
3065      /*retrieve xptr by import structure*/
3066      strcpy(C2F(cha1).buf,"xptr");
3067      ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
3068      ptr_int = (int *) ptr;
3069      xptr = ptr_int;
3070
3071      /*retrieve zcptr by import structure*/
3072      strcpy(C2F(cha1).buf,"zcptr");
3073      ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
3074      ptr_int = (int *) ptr;
3075      zcptr = ptr_int;
3076
3077      /*retrieve x and xd by import structure*/
3078      strcpy(C2F(cha1).buf,"x");
3079      ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
3080      ptr_dd = (double *) ptr;
3081      x = ptr_dd;
3082      xd = &x[xptr[nblk]-1];
3083
3084      /*retrieve g by import structure*/
3085      strcpy(C2F(cha1).buf,"g");
3086      ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
3087      ptr_dd = (double *) ptr;
3088      g = ptr_dd;
3089
3090      /* store blklst on stack */
3091      Topsave=Top;     /* save Top counter */
3092      Top=Top-Rhs+1+j; /* adjust Top counter */
3093
3094      for (k=0;k<nblk;k++)
3095      {/* for each block, call createblklist */
3096
3097       /* set flag_imp <0 for createblklst */
3098       i=-1;
3099
3100       /* the following test is done in order to know if block k
3101        * have been already called with callf in scicos.c
3102        */
3103       if (ptr_scsblk[k].nx!=0)
3104       {
3105        if (ptr_scsblk[k].x!=&x[xptr[k]-1])
3106        {
3107          /*fprintf(stderr,"k=%d,X,xd Non initialisé\n",k);*/
3108         /* set flag_imp=k for createblklst <0 */
3109         i=k;
3110        }
3111       }
3112       if (ptr_scsblk[k].ng!=0)
3113       {
3114        if ((ptr_scsblk[k].g!=&g[zcptr[k]-1]) && (ptr_scsblk[k].g!=&x[xptr[k]-1]))
3115        {
3116         /*fprintf(stderr,"k=%d,g Non initialisé\n",k);*/
3117         /* set flag_imp=k for createblklst <0 */
3118         i=k;
3119        }
3120       }
3121       /* call createblklist */
3122       ierr=createblklist(&ptr_scsblk[k], &errc,i);
3123
3124       /* if an error occurs in createblklist */
3125       if (ierr==FALSE_)
3126       {
3127        Top=Topsave;
3128        break;
3129       }
3130      }
3131      /* if success, create a list of Typed list scicos_block */
3132      if (ierr==TRUE_)
3133      {
3134       C2F(mklist)(&nblk);
3135       Top=Topsave; /* adjust Top counter */
3136       CreateVar(j+2,LIST_DATATYPE,&nblk,(i=1,&i),&l_tmp); /* this is done to inform common intersci */
3137      }
3138
3139     }
3140    }
3141
3142   /*******************************************
3143    * outtb_elem coming from import structure
3144    *******************************************/
3145    else if ((strcmp(C2F(cha1).buf,"outtb_elem") == 0)) /* retrieve outtb_eleme */
3146    {
3147     /* retrieve dims and prt of asked array with getscicosvarsfromimport */
3148     ierr=getscicosvarsfromimport(C2F(cha1).buf,&ptr,&nv,&mv);
3149
3150     /* check ierr flag */
3151     if (ierr==TRUE_)
3152     {
3153      l_tmp = I_INT32; /* define type of integer */
3154      CreateVar(j+2,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&nv,&mv,&l_tmp); /* Create int32 variable at the top+j+1 addr. of the stack */
3155      il_tmp = (int *) istk(l_tmp);      /* Store value of address of istk(l_tmp) in il_tmp */
3156      ptr_elem = (outtb_el *) ptr;       /* cast void* ptr to int* ptr */
3157      for (i=0;i<nv;i++) /* copy returned array in istk */
3158      {
3159       il_tmp[i] = ptr_elem[i].lnk + 1; /* +1 is for the connection with outtb list */
3160       il_tmp[nv+i] = ptr_elem[i].pos + 1;
3161      }
3162     }
3163    }
3164
3165    /* if input argument doesn't match with any accepted string
3166     * then display an error message.
3167     */
3168    else
3169    {
3170     Scierror(999,"%s : Undefined field.\n",fname);
3171     FREE(dyn_char);
3172     return 0;
3173    }
3174
3175    /* if return a FALSE_ value in
3176     * error flag then display an error message.
3177     */
3178    if(ierr!=TRUE_)
3179    {
3180     Scierror(999,"%s : Error.\n",fname);
3181     FREE(dyn_char);
3182     return 0;
3183    }
3184   }
3185   /**********************
3186    * Create lsh argument
3187    **********************/
3188    /* create a tlist if number of string in rhs 1 is >1*/
3189    if (j>1) 
3190    {
3191     Top=Top+j;
3192     j++;
3193     C2F(mktlist)(&j);
3194     Top=Top-1;
3195     CreateVar(Rhs+2,TYPED_LIST_DATATYPE,&j,(i=1,&i),&l_tmp); /* this is done to inform common intersci */
3196    }
3197
3198    /* put new variable in lsh argument */
3199    LhsVar(1)=Rhs+2;
3200
3201    /* end */
3202    FREE(dyn_char);
3203    return 0;
3204 }
3205
3206 /* intcurblkc curblock interface routine
3207  *
3208  * [nblk]=curblock()
3209  *
3210  * rhs : empty
3211  * lhs : nblk : the current block (int32 scilab object)
3212  *
3213  * 20/06/06, Alan : Rewritten from original fortran
3214  * source code intcurblk in coselm.f.
3215  *
3216  */
3217 int intcurblkc(fname,fname_len)
3218                  char *fname;
3219                  unsigned long fname_len;
3220 {
3221   /***********************
3222    * variables declaration
3223    ***********************/
3224   /* address of the data of the output parameter */
3225   int l1;
3226   /* local counter variable */
3227   int j,k;
3228   /* definition of min/max output argument */
3229   static int minlhs=1, maxlhs=1;
3230
3231   /**************************
3232    * Check number of  outputs
3233    **************************/
3234   CheckLhs(minlhs,maxlhs);
3235
3236   /************************
3237    * Create int32 variable
3238    ************************/
3239   /* define type of integer */
3240   l1 = I_INT32;
3241   /* Create int32 variable at the top addr. of the stack */
3242   CreateVar(Rhs+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,(j=1,&j),(k=1,&k),&l1);
3243   /* Store value of C2F(curblk).kfun at the l1 address in istk */
3244   *istk(l1) = C2F(curblk).kfun;
3245
3246   /* return the value stored at Top address to lhs variable */
3247   LhsVar(1) = Rhs+1;
3248
3249   /* return 0 as default value */
3250   return 0;
3251 }
3252
3253 /* intbuildouttb build an initialized outtb list
3254  *
3255  * [outtb]=buildouttb(lnksz,lnktyp)
3256  *
3257  * rhs 1 : lnksz, give the size of scilab object in outtb
3258  *         can be all int type or double matrix
3259  *         can have n,2 or 2,n size
3260  *
3261  * rhs 2 : lnktyp, gives the type of scilab objetc in outtb
3262  *         1 : double
3263  *         2 : complex
3264  *         3 : int32
3265  *         4 : int16
3266  *         5 : int8
3267  *         6 : uint32
3268  *         7 : uint16
3269  *         8 : uint8
3270  *         else : double
3271  *         can be all int type or double matrix
3272  *         can have n,1 or 1,n size
3273  *
3274  * lhs 1 : a list of size n
3275  *
3276  * 02/07/06, Alan : Initial version.
3277  *
3278  */
3279
3280 int intbuildouttb(fname)
3281  char *fname;
3282 {
3283  static int l1, m1, n1;
3284  static int l2, m2, n2;
3285  static int l3,n3=1;
3286  SciIntMat M1,M2,M3;
3287
3288  int n_lnksz,n_lnktyp;
3289  int *lnksz=NULL,*lnktyp=NULL;
3290
3291  double *ptr_d,*ptr_dc;
3292  int *ptr_i;
3293  short *ptr_s;
3294  char *ptr_c;
3295  int *ptr_ui;
3296  short *ptr_us;
3297  char *ptr_uc;
3298
3299  int nm,i,j,ierr=0;
3300
3301  static int minlhs=1, maxlhs=1, minrhs=2, maxrhs=2;
3302
3303  /*check number of lhs/rhs*/
3304  CheckLhs(minlhs,maxlhs);
3305  CheckRhs(minrhs,maxrhs);
3306
3307  /*check type of Rhs 1*/
3308  if (VarType(1)==sci_matrix)
3309  {
3310   GetRhsVar(1,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
3311  }
3312  else if (VarType(1)==sci_ints)
3313  {
3314   GetRhsVar(1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m1, &n1, &M1);
3315  }
3316  else
3317  {
3318   Scierror(888,"%s : first argument must be double or int32.\n",fname);
3319   return 0;
3320  }
3321  /*check size of Rhs 1*/
3322  if (m1==2) n_lnksz=n1;
3323  else if (n1==2) n_lnksz=m1;
3324  else
3325  {
3326   Scierror(888,"%s : bad dimension for first argument.\n",fname);
3327   return 0;
3328  }
3329  /*allocate lnksz*/
3330  if ((lnksz=MALLOC(2*n_lnksz*sizeof(int)))==NULL)
3331  {
3332   Scierror(999,"%s : No more free memory.\n",fname);
3333   return 0;
3334  }
3335
3336  /*check type of Rhs 2*/
3337  if (VarType(2)==sci_matrix)
3338  {
3339   GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &l2);
3340  }
3341  else if (VarType(2)==sci_ints)
3342  {
3343   GetRhsVar(2,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m2, &n2, &M2);
3344  }
3345  else
3346  {
3347   Scierror(888,"%s : second argument must be double or int32.\n",fname);
3348   if (lnksz!=NULL) FREE(lnksz);
3349   return 0;
3350  }
3351  /*check size of Rhs 2*/
3352  if (m2==1) n_lnktyp=n2;
3353  else if (n2==1) n_lnktyp=m2;
3354  else
3355  {
3356   Scierror(888,"%s : bad dimension for second argument.\n",fname);
3357   if (lnksz!=NULL) FREE(lnksz);
3358   return 0;
3359  }
3360
3361  /*cross size checking*/
3362  if (n_lnksz!=n_lnktyp)
3363  {
3364   Scierror(888,"%s : first and second argument must have "
3365                "the same length.\n",fname);
3366   if (lnksz!=NULL) FREE(lnksz);
3367   return 0;
3368  }
3369
3370  /* Allocate lnktyp*/
3371  if ((lnktyp=MALLOC(n_lnktyp*sizeof(int)))==NULL)
3372  {
3373   Scierror(999,"%s : No more free memory.\n",fname);
3374   if (lnksz!=NULL) FREE(lnksz);
3375   return 0;
3376  }
3377
3378  /*store rhs 1 in lnksz */
3379  if ((m1==n1)&&(m2==m1)) m1=-1; /* this is done for matrix 2,2 */
3380  if (VarType(1)==sci_ints)
3381  {
3382   switch (M1.it)
3383   {
3384    case I_CHAR   : if (m1==2)
3385                    {
3386                     for(j=0;j<n_lnksz;j++)
3387                     {
3388                      lnksz[j]=(int) IC_CHAR(M1.D)[j*2];
3389                      lnksz[n_lnksz+j]=(int) IC_CHAR(M1.D)[2*j+1];
3390                     }
3391                    }
3392                    else
3393                    {
3394                     for(j=0;j<2*n_lnksz;j++)
3395                       lnksz[j]=(int) IC_CHAR(M1.D)[j];
3396                    }
3397                    break;
3398
3399    case I_INT16  : if (m1==2)
3400                    {
3401                     for(j=0;j<n_lnksz;j++)
3402                     {
3403                      lnksz[j]=(int) IC_INT16(M1.D)[j*2];
3404                      lnksz[n_lnksz+j]=(int) IC_INT16(M1.D)[2*j+1];
3405                     }
3406                    }
3407                    else
3408                    {
3409                     for(j=0;j<2*n_lnksz;j++)
3410                       lnksz[j]=(int) IC_INT16(M1.D)[j];
3411                    }
3412                    break;
3413
3414    case I_INT32  : if (m1==2)
3415                    {
3416                     for(j=0;j<n_lnksz;j++)
3417                     {
3418                      lnksz[j]=(int) IC_INT32(M1.D)[j*2];
3419                      lnksz[n_lnksz+j]=(int) IC_INT32(M1.D)[2*j+1];
3420                     }
3421                    }
3422                    else
3423                    {
3424                     for(j=0;j<2*n_lnksz;j++)
3425                       lnksz[j]=(int) IC_INT32(M1.D)[j];
3426                    }
3427                    break;
3428
3429    case I_UCHAR  : if (m1==2)
3430                    {
3431                     for(j=0;j<n_lnksz;j++)
3432                     {
3433                      lnksz[j]=(int) IC_UCHAR(M1.D)[j*2];
3434                      lnksz[n_lnksz+j]=(int) IC_UCHAR(M1.D)[2*j+1];
3435                     }
3436                    }
3437                    else
3438                    {
3439                     for(j=0;j<2*n_lnksz;j++)
3440                       lnksz[j]=(int) IC_UCHAR(M1.D)[j];
3441                    }
3442                    break;
3443
3444    case I_UINT16 : if (m1==2)
3445                    {
3446                     for(j=0;j<n_lnksz;j++)
3447                     {
3448                      lnksz[j]=(int) IC_UINT16(M1.D)[j*2];
3449                      lnksz[n_lnksz+j]=(int) IC_UINT16(M1.D)[2*j+1];
3450                     }
3451                    }
3452                    else
3453                    {
3454                     for(j=0;j<2*n_lnksz;j++)
3455                       lnksz[j]=(int) IC_UINT16(M1.D)[j];
3456                    }
3457                    break;
3458
3459    case I_UINT32 : if (m1==2)
3460                    {
3461                     for(j=0;j<n_lnksz;j++)
3462                     {
3463                      lnksz[j]=(int) IC_UINT32(M1.D)[j*2];
3464                      lnksz[n_lnksz+j]=(int) IC_UINT32(M1.D)[2*j+1];
3465                     }
3466                    }
3467                    else
3468                    {
3469                     for(j=0;j<2*n_lnksz;j++)
3470                       lnksz[j]=(int) IC_UINT32(M1.D)[j];
3471                    }
3472                    break;
3473   }
3474  }
3475  else
3476  {
3477   if (m1==2)
3478   {
3479    for(j=0;j<n_lnksz;j++)
3480    {
3481     lnksz[j]=(int) ((double *) stk(l1))[j*2];
3482     lnksz[n_lnksz+j]=(int) ((double *) stk(l1))[2*j+1];
3483    }
3484   }
3485   else
3486   {
3487    for(j=0;j<2*n_lnksz;j++)
3488        lnksz[j]=(int) ((double *) stk(l1))[j];
3489   }
3490  }
3491
3492  /*store rhs 2 in lnktyp */
3493  if (VarType(2)==sci_ints)
3494  {
3495   switch (M2.it)
3496   {
3497    case I_CHAR   : for(j=0;j<n_lnktyp;j++)
3498                      lnktyp[j]=(int) IC_CHAR(M2.D)[j];
3499                    break;
3500
3501    case I_INT16  : for(j=0;j<n_lnktyp;j++)
3502                      lnktyp[j]=(int) IC_INT16(M2.D)[j];
3503                    break;
3504
3505    case I_INT32  : for(j=0;j<n_lnktyp;j++)
3506                      lnktyp[j]=(int) IC_INT32(M2.D)[j];
3507                    break;
3508
3509    case I_UCHAR  : for(j=0;j<n_lnktyp;j++)
3510                      lnktyp[j]=(int) IC_UCHAR(M2.D)[j];
3511                    break;
3512
3513    case I_UINT16 : for(j=0;j<n_lnktyp;j++)
3514                      lnktyp[j]=(int) IC_UINT16(M2.D)[j];
3515                    break;
3516
3517    case I_UINT32 : for(j=0;j<n_lnktyp;j++)
3518                      lnktyp[j]=(int) IC_UINT32(M2.D)[j];
3519                    break;
3520   }
3521  }
3522  else
3523  {
3524   for(j=0;j<n_lnktyp;j++)
3525     lnktyp[j]=(int) ((double *) stk(l2))[j];
3526  }
3527
3528  /* build output list */
3529  CreateVar(3,LIST_DATATYPE,&n_lnktyp,&n3,&l3);
3530
3531  for(i=0;i<n_lnktyp;i++)
3532  {
3533   nm=lnksz[i]*lnksz[i+n_lnktyp];
3534   switch (lnktyp[i])
3535   {
3536    case 1  : if ((ptr_d=MALLOC(nm*sizeof(double)))==NULL)
3537              {
3538               ierr=-1;
3539               break;
3540              }
3541              for (j=0;j<nm;j++) ptr_d[j]=0;
3542              CreateListVarFromPtr(3,i+1,MATRIX_OF_DOUBLE_DATATYPE,&lnksz[i],&lnksz[i+n_lnktyp], &ptr_d);
3543              FREE(ptr_d);
3544              break;
3545
3546    case 2  : if ((ptr_d=MALLOC(2*nm*sizeof(double)))==NULL)
3547              {
3548               ierr=-1;
3549               break;
3550              }
3551              for (j=0;j<2*nm;j++) ptr_d[j]=0;
3552              ptr_dc = &ptr_d[nm];
3553              CreateListCVarFromPtr(3,i+1,"d",(j=1,&j),&lnksz[i],&lnksz[i+n_lnktyp],&ptr_d,&ptr_dc);
3554              FREE(ptr_d);
3555              break;
3556
3557    case 3  : if ((ptr_i=MALLOC(nm*sizeof(int)))==NULL)
3558              {
3559               ierr=-1;
3560               break;
3561              }
3562              for (j=0;j<nm;j++) ptr_i[j]=0;
3563              M3.m = lnksz[i];
3564              M3.n = lnksz[i+n_lnktyp];
3565              M3.it = 4;
3566              M3.l = -1;
3567              M3.D = ptr_i;
3568              CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
3569              FREE(ptr_i);
3570              break;
3571
3572    case 4  : if ((ptr_s=MALLOC(nm*sizeof(short)))==NULL)
3573              {
3574               ierr=-1;
3575               break;
3576              }
3577              for (j=0;j<nm;j++) ptr_s[j]=0;
3578              M3.m = lnksz[i];
3579              M3.n = lnksz[i+n_lnktyp];
3580              M3.it = 2;
3581              M3.l = -1;
3582              M3.D = ptr_s;
3583              CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
3584              FREE(ptr_s);
3585              break;
3586
3587    case 5  : if ((ptr_c=MALLOC(nm*sizeof(char)))==NULL)
3588              {
3589               ierr=-1;
3590               break;
3591              }
3592              for (j=0;j<nm;j++) ptr_c[j]=0;
3593              M3.m = lnksz[i];
3594              M3.n = lnksz[i+n_lnktyp];
3595              M3.it = 1;
3596              M3.l = -1;
3597              M3.D = ptr_c;
3598              CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
3599              FREE(ptr_c);
3600              break;
3601
3602    case 6  : if ((ptr_ui=MALLOC(nm*sizeof(unsigned int)))==NULL)
3603              {
3604               ierr=-1;
3605               break;
3606              }
3607              for (j=0;j<nm;j++) ptr_ui[j]=0;
3608              M3.m = lnksz[i];
3609              M3.n = lnksz[i+n_lnktyp];
3610              M3.it = 14;
3611              M3.l = -1;
3612              M3.D = ptr_ui;
3613              CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
3614              FREE(ptr_ui);
3615              break;
3616
3617    case 7  : if ((ptr_us=MALLOC(nm*sizeof(unsigned short)))==NULL)
3618              {
3619               ierr=-1;
3620               break;
3621              }
3622              for (j=0;j<nm;j++) ptr_us[j]=0;
3623              M3.m = lnksz[i];
3624              M3.n = lnksz[i+n_lnktyp];
3625              M3.it = 12;
3626              M3.l = -1;
3627              M3.D = ptr_us;
3628              CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
3629              FREE(ptr_us);
3630              break;
3631
3632    case 8  : if ((ptr_uc=MALLOC(nm*sizeof(unsigned char)))==NULL)
3633              {
3634               ierr=-1;
3635               break;
3636              }
3637              for (j=0;j<nm;j++) ptr_uc[j]=0;
3638              M3.m = lnksz[i];
3639              M3.n = lnksz[i+n_lnktyp];
3640              M3.it = 11;
3641              M3.l = -1;
3642              M3.D = ptr_uc;
3643              CreateListVarFromPtr(3,i+1,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE,&M3.m,&M3.n,&M3);
3644              FREE(ptr_uc);
3645              break;
3646
3647    default : if ((ptr_d=MALLOC(nm*sizeof(double)))==NULL)
3648              {
3649               ierr=-1;
3650               break;
3651              }
3652              for (j=0;j<nm;j++) ptr_d[j]=0;
3653              CreateListVarFromPtr(3,i+1,MATRIX_OF_DOUBLE_DATATYPE,&lnksz[i],&lnksz[i+n_lnktyp], &ptr_d);
3654              FREE(ptr_d);
3655              break;
3656   }
3657
3658   if (ierr==-1)
3659   {
3660    Scierror(999,"%s : No more memory.\n",fname);
3661    FREE(lnksz);
3662    FREE(lnktyp);
3663    return 0;
3664   }
3665  }
3666
3667  LhsVar(1)=3;
3668
3669  FREE(lnksz);
3670  FREE(lnktyp);
3671  return 0;
3672 }