cfb636024d91c0d1fb9d60574412c78c5fe4479c
[scilab.git] / scilab / modules / scicos / sci_gateway / c / sci_model2blk.c
1 /*  Scicos
2 *
3 *  Copyright (C) INRIA -
4 *
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18 *
19 * See the file ./license.txt
20 */
21 /*--------------------------------------------------------------------------*/
22 #include <stdio.h>
23 #include "gw_scicos.h"
24 #include "stack-c.h"
25 #include "Scierror.h"
26 #include "localization.h"
27 #include "scicos_block4.h"
28 #include "MALLOC.h"
29 #include "cvstr.h"
30 #include "sciblk4.h"
31 #include "sciblk2.h"
32 #include "MlistGetFieldNumber.h"
33 #include "dynamic_link.h"
34 #include "createblklist.h"
35 #include "scicos.h"
36 /*--------------------------------------------------------------------------*/
37 extern int *listentry(int *header, int i);
38 extern int C2F(funnum) (char *fname);
39 extern int C2F(namstr)();
40 extern void  F2C(sciblk)();
41 /*--------------------------------------------------------------------------*/
42 extern int ntabsim;
43 extern OpTab tabsim[];
44 /*--------------------------------------------------------------------------*/
45 /* model2blk Build a scicos_block structure from
46 * a scicos model
47 *
48 * [Block] = model2blk(objs.model)
49 *
50 * rhs 1 : a scicos model Tlist
51 *        - 1  : model(1)     : !model      sim     in      in2     intyp    out    out2  outtyp
52 *                               evtin      evtout  state   dstate  odstate  rpar   ipar  opar
53 *                               blocktype  firing  dep_ut  label   nzcross  nmode  equations  !
54 *        - 2  : model.sim       :
55 *        - 3  : model.in        :
56 *        - 4  : model.in2       :
57 *        - 5  : model.intyp     :
58 *        - 6  : model.out       :
59 *        - 7  : model.out2      :
60 *        - 8  : model.outtyp    :
61 *        - 9  : model.evtin     :
62 *        - 10 : model.evtout    :
63 *        - 11 : model.state     :
64 *        - 12 : model.dsate     :
65 *        - 13 : model.odsate    :
66 *        - 14 : model.rpar      :
67 *        - 15 : model.ipar      :
68 *        - 16 : model.opar      :
69 *        - 17 : model.blocktype :
70 *        - 18 : model.firing    :
71 *        - 19 : model.dep_ut    :
72 *        - 20 : model.label     :
73 *        - 21 : model.nzcross   :
74 *        - 22 : model.nmode      :
75 *        - 23 : model.equations :
76 *
77 * lhs 1 : a scicos block Tlist
78 *
79 * initial rev 12/11/07, Alan
80 * 05/07/08, Alan : fix for xprop
81 *                  add extra comments
82 *                  check in/out size and type
83 *
84 */
85 int sci_model2blk(char *fname, unsigned long fname_len)
86 {
87     int m1 = 0, n1 = 0;
88     int *il1 = NULL;
89     int n = 0;
90     int mh = 0, nh = 0;
91     int *ilh = NULL;
92     int mh2 = 0, nh2 = 0;
93     int *ilh2 = NULL;
94     int mh3 = 0, nh3 = 0;
95     int *ilh3 = NULL;
96     int ierr = 0;
97     int TopSave = 0;
98     int i = 0, j = 0;
99     int l_tmp = 0;
100     double type = 0.0;
101     int len_str = 0;
102     int lfunpt = 0;
103     int typfsim = 0;
104     int ifun = 0;
105     int *il_sim = NULL;
106
107     int id[nsiz];
108
109     double *ptr_d = NULL;
110     char *ptr_c = NULL;
111     unsigned char *ptr_uc = NULL;
112     short *ptr_s = NULL;
113     unsigned short *ptr_us = NULL;
114     long *ptr_l = NULL;
115     unsigned long *ptr_ul = NULL;
116     int nblklst = 40;
117
118     scicos_block Block;
119     memset(&Block, 0, sizeof(scicos_block));
120
121
122
123     /* check size of rhs/lhs parameters */
124     CheckRhs(1, 1);
125     CheckLhs(1, 1);
126
127     il1 = (int *) GetData(1);
128     m1  = il1[1];
129     n1  = il1[2];
130
131     /* check for a tlist */
132     if (il1[0] != sci_mlist)
133     {
134         Scierror(888, _("%s : First argument must be a Typed list.\n"), fname);
135         return 0;
136     }
137
138     /* check for a type "scicos model" */
139     ilh = (int *) (listentry(il1, 1));
140     mh  = ilh[1];
141     nh  = ilh[2];
142     if ((ilh[mh * nh + 5] != 22) || \
143             (ilh[mh * nh + 6] != 24) || \
144             (ilh[mh * nh + 7] != 13) || \
145             (ilh[mh * nh + 8] != 14) || \
146             (ilh[mh * nh + 9] != 21))
147     {
148         Scierror(888, _("%s : First argument must be a scicos model.\n"), fname);
149         return 0;
150     }
151
152     /* TODO */
153     /* 2 : model.sim  */
154     n            = MlistGetFieldNumber(il1, "sim");
155     ilh          = (int *) (listentry(il1, n));
156     mh           = ilh[1];
157     nh           = ilh[2];
158     if (ilh[0] == sci_list)
159     {
160         /* sim  is a list */
161         ilh2 = (int *) (listentry(ilh, 2));
162         Block.type = (int) * ((double *) (&ilh2[4]));
163         ilh2 = (int *) (listentry(ilh, 1));
164         typfsim = ilh2[0]; /* typfsim  the name the comput funct */
165         il_sim = ilh2;
166     }
167     else
168     {
169         Block.type = 0;
170         typfsim = ilh[0];
171         il_sim = ilh;
172     }
173     /* check if typfsim is a scilab function */
174     if ((typfsim == sci_u_function) || (typfsim == sci_c_function))
175     {
176         /* TODO */
177         lfunpt = -1;
178     }
179     /* check if typfsim is a string */
180     else if (typfsim == sci_strings)
181     {
182         len_str = il_sim[5] - 1;
183         C2F(cha1).buf[0] = ' ';
184         C2F(cvstr)(&len_str, &il_sim[6], &C2F(cha1).buf[0], (j = 1, &j), len_str);
185         C2F(cha1).buf[len_str] = '\0';
186         /* search fun ptr of the comput func in the scilab func table */
187         ifun = C2F(funnum)(C2F(cha1).buf);
188         if (ifun > 0) lfunpt = ifun;
189         else
190         {
191             C2F(namstr)(id, &il_sim[6], &len_str, (j = 0, &j));
192             C2F(com).fin = 0;
193             C2F(funs)(id);
194             if ((C2F(com).fun == -1) | (C2F(com).fun == -2)) lfunpt = -*Lstk(C2F(com).fin);
195             else
196             {
197                 lfunpt = 0;
198                 Scierror(888, _("%s : unknown block : %s\n"), fname, C2F(cha1).buf);
199                 return 0;
200             }
201         }
202     }
203     /* else {
204     * error
205     }*/
206     /* comput func is a scilab function */
207     if (lfunpt < 0)
208     {
209         switch (Block.type)
210         {
211             case 0:
212                 Block.funpt = F2C(sciblk);
213                 break;
214             case 1:
215                 Scierror(888, _("%s : type 1 function not allowed for scilab blocks\n"), fname);
216                 return 0;
217             case 2:
218                 Scierror(888, _("%s : type 2 function not allowed for scilab blocks\n"), fname);
219                 return 0;
220             case 3:
221                 Block.funpt = sciblk2;
222                 Block.type = 2;
223                 break;
224             case 5:
225                 Block.funpt = sciblk4;
226                 Block.type = 4;
227                 break;
228             case 99: /* debugging block */
229                 Block.funpt = sciblk4;
230                 Block.type = 4;
231                 break;
232             case 10005:
233                 Block.funpt = sciblk4;
234                 Block.type = 10004;
235                 break;
236             default :
237                 Scierror(888, _("%s : Undefined Function type\n"), fname);
238                 return 0;
239         }
240         Block.scsptr = -lfunpt;
241     }
242     else if (lfunpt <= ntabsim)
243     {
244         Block.funpt = *(tabsim[lfunpt - 1].fonc);
245         Block.scsptr = 0;
246     }
247     else
248     {
249         lfunpt -= (ntabsim + 1);
250         GetDynFunc(lfunpt, &Block.funpt);
251         if (Block.funpt == (voidf) 0)
252         {
253             Scierror(888, _("%s : Function not found\n"), fname);
254             return 0;
255         }
256         Block.scsptr = 0;
257     }
258
259     /* check input ports */
260     /* 3 : model.in  */
261     n            = MlistGetFieldNumber(il1, "in");
262     ilh          = (int *) (listentry(il1, n));
263     mh           = ilh[1];
264     nh           = ilh[2];
265     Block.nin    = mh * nh;
266     Block.insz   = NULL;
267     Block.inptr  = NULL;
268     if (mh*nh != 0)
269     {
270         /* check value of in */
271         for (i = 0; i < Block.nin; i++)
272         {
273             if ((*((double *)(&ilh[4]) + i)) <= 0.)
274             {
275                 Scierror(888, _("%s : Undetermined Size. in(%d)=%d. Please adjust your model.\n"), \
276                          fname, i + 1, (int)(*((double *)(&ilh[4]) + i)));
277                 return 0;
278             }
279         }
280         /* alloc insz */
281         if ((Block.insz = (int *) MALLOC(Block.nin * 3 * sizeof(int))) == NULL)
282         {
283             Scierror(888, _("%s : Allocation error.\n"), fname);
284             return 0;
285         }
286         /* alloc inptr */
287         if ((Block.inptr = (void **) MALLOC(Block.nin * sizeof(void *))) == NULL)
288         {
289             FREE(Block.insz);
290             Scierror(888, _("%s : Allocation error.\n"), fname);
291             return 0;
292         }
293         /* 4 : model.in2  */
294         n    = MlistGetFieldNumber(il1, "in2");
295         ilh2 = (int *) (listentry(il1, n));
296         mh2  = ilh2[1];
297         nh2  = ilh2[2];
298         /* check value of in2 */
299         for (i = 0; i < (mh2 * nh2); i++)
300         {
301             if ((*((double *)(&ilh2[4]) + i)) <= 0.)
302             {
303                 Scierror(888, _("%s : Undetermined Size. in2(%d)=%d. Please adjust your model.\n"), \
304                          fname, i + 1, (int)(*((double *)(&ilh2[4]) + i)));
305                 FREE(Block.insz);
306                 FREE(Block.inptr);
307                 return 0;
308             }
309         }
310         /* 5 : model.intyp  */
311         n    = MlistGetFieldNumber(il1, "intyp");
312         ilh3 = (int *) (listentry(il1, n));
313         mh3  = ilh3[1];
314         nh3  = ilh3[2];
315         /* check value of intyp */
316         for (i = 0; i < (mh3 * nh3); i++)
317         {
318             if ((*((double *)(&ilh3[4]) + i)) <= 0.)
319             {
320                 Scierror(888, _("%s : Undetermined Type. intyp(%d)=%d. Please adjust your model.\n"), \
321                          fname, i + 1, (int)(*((double *)(&ilh3[4]) + i)));
322                 FREE(Block.insz);
323                 FREE(Block.inptr);
324                 return 0;
325             }
326         }
327         if (((mh * nh) == (mh2 * nh2)) && (((mh * nh) == (mh3 * nh3))))
328         {
329             for (i = 0; i < Block.nin; i++)
330             {
331                 Block.insz[i] = (int) * ((double *)(&ilh[4]) + i);
332                 Block.insz[Block.nin + i] = (int) * ((double *)(&ilh2[4]) + i);
333                 type = *((double *)(&ilh3[4]) + i);
334                 if (type == 1) Block.insz[2 * Block.nin + i] = 10;
335                 else if (type == 2) Block.insz[2 * Block.nin + i] = 11;
336                 else if (type == 3) Block.insz[2 * Block.nin + i] = 84;
337                 else if (type == 4) Block.insz[2 * Block.nin + i] = 82;
338                 else if (type == 5) Block.insz[2 * Block.nin + i] = 81;
339                 else if (type == 6) Block.insz[2 * Block.nin + i] = 814;
340                 else if (type == 7) Block.insz[2 * Block.nin + i] = 812;
341                 else if (type == 8) Block.insz[2 * Block.nin + i] = 811;
342                 else Block.insz[2 * Block.nin + i] = 10;
343             }
344         }
345         else
346         {
347             for (i = 0; i < Block.nin; i++)
348             {
349                 Block.insz[i] = (int) * ((double *)(&ilh[4]) + i);
350                 Block.insz[Block.nin + i] = 1;
351                 Block.insz[2 * Block.nin + i] = 10;
352             }
353         }
354
355         for (i = 0; i < Block.nin; i++)
356         {
357             switch (Block.insz[2 * Block.nin + i])
358             {
359                 case 10  :
360                     if ((Block.inptr[i] = (double *) MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(double))) == NULL)
361                     {
362                         for (j = 0; j < i; j++) FREE(Block.inptr[j]);
363                         FREE(Block.inptr);
364                         FREE(Block.insz);
365                         Scierror(888, _("%s : Allocation error.\n"), fname);
366                         return 0;
367                     }
368                     ptr_d = (double *) Block.inptr[i];
369                     for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
370                     {
371                         ptr_d[j] = 0.;
372                     }
373                     break;
374                 case 11  :
375                     if ((Block.inptr[i] = (double *) \
376                                           MALLOC(2 * Block.insz[i] * Block.insz[Block.nin + i] * sizeof(double))) == NULL)
377                     {
378                         for (j = 0; j < i; j++) FREE(Block.inptr[j]);
379                         FREE(Block.inptr);
380                         FREE(Block.insz);
381                         Scierror(888, _("%s : Allocation error.\n"), fname);
382                         return 0;
383                     }
384                     ptr_d = (double *) Block.inptr[i];
385                     for (j = 0; j < 2 * Block.insz[i]*Block.insz[Block.nin + i]; j++)
386                     {
387                         ptr_d[j] = 0.;
388                     }
389                     break;
390                 case 84  :
391                     if ((Block.inptr[i] = (long *) \
392                                           MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(long))) == NULL)
393                     {
394                         for (j = 0; j < i; j++) FREE(Block.inptr[j]);
395                         FREE(Block.inptr);
396                         FREE(Block.insz);
397                         Scierror(888, _("%s : Allocation error.\n"), fname);
398                         return 0;
399                     }
400                     ptr_l = (long *) Block.inptr[i];
401                     for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
402                     {
403                         ptr_l[j] = 0;
404                     }
405                     break;
406                 case 82  :
407                     if ((Block.inptr[i] = (short *) \
408                                           MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(short))) == NULL)
409                     {
410                         for (j = 0; j < i; j++) FREE(Block.inptr[j]);
411                         FREE(Block.inptr);
412                         FREE(Block.insz);
413                         Scierror(888, _("%s : Allocation error.\n"), fname);
414                         return 0;
415                     }
416                     ptr_s = (short *) Block.inptr[i];
417                     for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
418                     {
419                         ptr_s[j] = 0;
420                     }
421                     break;
422                 case 81  :
423                     if ((Block.inptr[i] = (char *) \
424                                           MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(char))) == NULL)
425                     {
426                         for (j = 0; j < i; j++) FREE(Block.inptr[j]);
427                         FREE(Block.inptr);
428                         FREE(Block.insz);
429                         Scierror(888, _("%s : Allocation error.\n"), fname);
430                         return 0;
431                     }
432                     ptr_c = (char *) Block.inptr[i];
433                     for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
434                     {
435                         ptr_c[j] = 0;
436                     }
437                     break;
438                 case 814 :
439                     if ((Block.inptr[i] = (unsigned long *) \
440                                           MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(unsigned long))) == NULL)
441                     {
442                         for (j = 0; j < i; j++) FREE(Block.inptr[j]);
443                         FREE(Block.inptr);
444                         FREE(Block.insz);
445                         Scierror(888, _("%s : Allocation error.\n"), fname);
446                         return 0;
447                     }
448                     ptr_ul = (unsigned long *) Block.inptr[i];
449                     for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
450                     {
451                         ptr_ul[j] = 0;
452                     }
453                     break;
454                 case 812 :
455                     if ((Block.inptr[i] = (unsigned short *) \
456                                           MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(unsigned short))) == NULL)
457                     {
458                         for (j = 0; j < i; j++) FREE(Block.inptr[j]);
459                         FREE(Block.inptr);
460                         FREE(Block.insz);
461                         Scierror(888, _("%s : Allocation error.\n"), fname);
462                         return 0;
463                     }
464                     ptr_us = (unsigned short *) Block.inptr[i];
465                     for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
466                     {
467                         ptr_us[j] = 0;
468                     }
469                     break;
470                 case 811 :
471                     if ((Block.inptr[i] = (unsigned char *) \
472                                           MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(unsigned char))) == NULL)
473                     {
474                         for (j = 0; j < i; j++) FREE(Block.inptr[j]);
475                         FREE(Block.inptr);
476                         FREE(Block.insz);
477                         Scierror(888, _("%s : Allocation error.\n"), fname);
478                         return 0;
479                     }
480                     ptr_uc = (unsigned char *) Block.inptr[i];
481                     for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
482                     {
483                         ptr_uc[j] = 0;
484                     }
485                     break;
486             }
487         }
488     }
489
490     /* check output ports */
491     /* 6 : model.out  */
492     n            = MlistGetFieldNumber(il1, "out");
493     ilh          = (int *) (listentry(il1, n));
494     mh           = ilh[1];
495     nh           = ilh[2];
496     Block.nout   = mh * nh;
497     Block.outsz  = NULL;
498     Block.outptr = NULL;
499     if (mh*nh != 0)
500     {
501         /* check value of out */
502         for (i = 0; i < Block.nout; i++)
503         {
504             if ((*((double *)(&ilh[4]) + i)) <= 0.)
505             {
506                 Scierror(888, _("%s : Undetermined Size. out(%d)=%d. Please adjust your model.\n"), \
507                          fname, i + 1, (int)(*((double *)(&ilh[4]) + i)));
508                 for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
509                 FREE(Block.inptr);
510                 FREE(Block.insz);
511                 return 0;
512             }
513         }
514         /* alloc outsz */
515         if ((Block.outsz = (int *) MALLOC(Block.nout * 3 * sizeof(int))) == NULL)
516         {
517             Scierror(888, _("%s : Allocation error.\n"), fname);
518             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
519             FREE(Block.inptr);
520             FREE(Block.insz);
521             return 0;
522         }
523         /* alloc outptr */
524         if ((Block.outptr = (void **) MALLOC(Block.nout * sizeof(void *))) == NULL)
525         {
526             FREE(Block.outsz);
527             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
528             FREE(Block.inptr);
529             FREE(Block.insz);
530             Scierror(888, _("%s : Allocation error.\n"), fname);
531             return 0;
532         }
533         /* 7 : model.out2  */
534         n    = MlistGetFieldNumber(il1, "out2");
535         ilh2 = (int *) (listentry(il1, n));
536         mh2  = ilh2[1];
537         nh2  = ilh2[2];
538         /* check value of out2 */
539         for (i = 0; i < (mh2 * nh2); i++)
540         {
541             if ((*((double *)(&ilh2[4]) + i)) <= 0.)
542             {
543                 Scierror(888, _("%s : Undetermined Size. out2(%d)=%d. Please adjust your model.\n"), \
544                          fname, i + 1, (int)(*((double *)(&ilh2[4]) + i)));
545                 for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
546                 FREE(Block.insz);
547                 FREE(Block.inptr);
548                 FREE(Block.outptr);
549                 FREE(Block.outsz);
550                 return 0;
551             }
552         }
553         /* 8 : model.outtyp  */
554         n    = MlistGetFieldNumber(il1, "outtyp");
555         ilh3 = (int *) (listentry(il1, n));
556         mh3  = ilh3[1];
557         nh3  = ilh3[2];
558         /* check value of intyp */
559         for (i = 0; i < (mh3 * nh3); i++)
560         {
561             if ((*((double *)(&ilh3[4]) + i)) <= 0.)
562             {
563                 Scierror(888, _("%s : Undetermined Type. outtyp(%d)=%d. Please adjust your model.\n"), \
564                          fname, i + 1, (int)(*((double *)(&ilh3[4]) + i)));
565                 FREE(Block.insz);
566                 FREE(Block.inptr);
567                 FREE(Block.outptr);
568                 FREE(Block.outsz);
569                 return 0;
570             }
571         }
572         if (((mh * nh) == (mh2 * nh2)) && (((mh * nh) == (mh3 * nh3))))
573         {
574             for (i = 0; i < Block.nout; i++)
575             {
576                 Block.outsz[i] = (int) * ((double *)(&ilh[4]) + i);
577                 Block.outsz[Block.nout + i] = (int) * ((double *)(&ilh2[4]) + i);
578                 type = *((double *)(&ilh3[4]) + i);
579                 if (type == 1) Block.outsz[2 * Block.nout + i] = 10;
580                 else if (type == 2) Block.outsz[2 * Block.nout + i] = 11;
581                 else if (type == 3) Block.outsz[2 * Block.nout + i] = 84;
582                 else if (type == 4) Block.outsz[2 * Block.nout + i] = 82;
583                 else if (type == 5) Block.outsz[2 * Block.nout + i] = 81;
584                 else if (type == 6) Block.outsz[2 * Block.nout + i] = 814;
585                 else if (type == 7) Block.outsz[2 * Block.nout + i] = 812;
586                 else if (type == 8) Block.outsz[2 * Block.nout + i] = 811;
587                 else Block.outsz[2 * Block.nout + i] = 10;
588             }
589         }
590         else
591         {
592             for (i = 0; i < Block.nout; i++)
593             {
594                 Block.outsz[i] = (int) * ((double *)(&ilh[4]) + i);
595                 Block.outsz[Block.nout + i] = 1;
596                 Block.outsz[2 * Block.nout + i] = 10;
597             }
598         }
599         for (i = 0; i < Block.nout; i++)
600         {
601             switch (Block.outsz[2 * Block.nout + i])
602             {
603                 case 10  :
604                     if ((Block.outptr[i] = (double *) \
605                                            MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(double))) == NULL)
606                     {
607                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
608                         FREE(Block.inptr);
609                         FREE(Block.insz);
610                         for (j = 0; j < i; j++) FREE(Block.outptr[j]);
611                         FREE(Block.outptr);
612                         FREE(Block.outsz);
613                         Scierror(888, _("%s : Allocation error.\n"), fname);
614                         return 0;
615                     }
616                     ptr_d = (double *) Block.outptr[i];
617                     for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
618                     {
619                         ptr_d[j] = 0.;
620                     }
621                     break;
622                 case 11  :
623                     if ((Block.outptr[i] = (double *) \
624                                            MALLOC(2 * Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(double))) == NULL)
625                     {
626                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
627                         FREE(Block.inptr);
628                         FREE(Block.insz);
629                         for (j = 0; j < i; j++) FREE(Block.outptr[j]);
630                         FREE(Block.outptr);
631                         FREE(Block.outsz);
632                         Scierror(888, _("%s : Allocation error.\n"), fname);
633                         return 0;
634                     }
635                     ptr_d = (double *) Block.outptr[i];
636                     for (j = 0; j < 2 * Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
637                     {
638                         ptr_d[j] = 0.;
639                     }
640                     break;
641                 case 84  :
642                     if ((Block.outptr[i] = (long *) \
643                                            MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(long))) == NULL)
644                     {
645                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
646                         FREE(Block.inptr);
647                         FREE(Block.insz);
648                         for (j = 0; j < i; j++) FREE(Block.outptr[j]);
649                         FREE(Block.outptr);
650                         FREE(Block.outsz);
651                         Scierror(888, _("%s : Allocation error.\n"), fname);
652                         return 0;
653                     }
654                     ptr_l = (long *) Block.outptr[i];
655                     for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
656                     {
657                         ptr_l[j] = 0;
658                     }
659                     break;
660                 case 82  :
661                     if ((Block.outptr[i] = (short *) \
662                                            MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(short))) == NULL)
663                     {
664                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
665                         FREE(Block.inptr);
666                         FREE(Block.insz);
667                         for (j = 0; j < i; j++) FREE(Block.outptr[j]);
668                         FREE(Block.outptr);
669                         FREE(Block.outsz);
670                         Scierror(888, _("%s : Allocation error.\n"), fname);
671                         return 0;
672                     }
673                     ptr_s = (short *) Block.outptr[i];
674                     for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
675                     {
676                         ptr_s[j] = 0;
677                     }
678                     break;
679                 case 81  :
680                     if ((Block.outptr[i] = (char *) \
681                                            MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(char))) == NULL)
682                     {
683                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
684                         FREE(Block.inptr);
685                         FREE(Block.insz);
686                         for (j = 0; j < i; j++) FREE(Block.outptr[j]);
687                         FREE(Block.outptr);
688                         FREE(Block.outsz);
689                         Scierror(888, _("%s : Allocation error.\n"), fname);
690                         return 0;
691                     }
692                     ptr_c = (char *) Block.outptr[i];
693                     for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
694                     {
695                         ptr_c[j] = 0;
696                     }
697                     break;
698                 case 814 :
699                     if ((Block.outptr[i] = (unsigned long *) \
700                                            MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(unsigned long))) == NULL)
701                     {
702                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
703                         FREE(Block.inptr);
704                         FREE(Block.insz);
705                         for (j = 0; j < i; j++) FREE(Block.outptr[j]);
706                         FREE(Block.outptr);
707                         FREE(Block.outsz);
708                         Scierror(888, _("%s : Allocation error.\n"), fname);
709                         return 0;
710                     }
711                     ptr_ul = (unsigned long *) Block.outptr[i];
712                     for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
713                     {
714                         ptr_ul[j] = 0;
715                     }
716                     break;
717                 case 812 :
718                     if ((Block.outptr[i] = (unsigned short *) \
719                                            MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(unsigned short))) == NULL)
720                     {
721                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
722                         FREE(Block.inptr);
723                         FREE(Block.insz);
724                         for (j = 0; j < i; j++) FREE(Block.outptr[j]);
725                         FREE(Block.outptr);
726                         FREE(Block.outsz);
727                         Scierror(888, _("%s : Allocation error.\n"), fname);
728                         return 0;
729                     }
730                     ptr_us = (unsigned short *) Block.outptr[i];
731                     for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
732                     {
733                         ptr_us[j] = 0;
734                     }
735                     break;
736                 case 811 :
737                     if ((Block.outptr[i] = (unsigned char *) \
738                                            MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(unsigned char))) == NULL)
739                     {
740                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
741                         FREE(Block.inptr);
742                         FREE(Block.insz);
743                         for (j = 0; j < i; j++) FREE(Block.outptr[j]);
744                         FREE(Block.outptr);
745                         FREE(Block.outsz);
746                         Scierror(888, _("%s : Allocation error.\n"), fname);
747                         return 0;
748                     }
749                     ptr_uc = (unsigned char *) Block.outptr[i];
750                     for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
751                     {
752                         ptr_uc[j] = 0;
753                     }
754                     break;
755             }
756         }
757     }
758
759     /* event input port */
760     /* 9 : model.evtin  */
761
762     /* event output port  */
763     /* 10 : model.evtout  */
764     n            = MlistGetFieldNumber(il1, "evtout");
765     ilh          = (int *) (listentry(il1, n));
766     mh           = ilh[1];
767     nh           = ilh[2];
768     Block.nevout = mh * nh;
769     Block.evout  = NULL;
770     if (mh*nh != 0)
771     {
772         if ((Block.evout = (double *) MALLOC(Block.nevout * sizeof(double))) == NULL)
773         {
774             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
775             FREE(Block.inptr);
776             FREE(Block.insz);
777             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
778             FREE(Block.outptr);
779             FREE(Block.outsz);
780             Scierror(888, _("%s : Allocation error.\n"), fname);
781             return 0;
782         }
783         n            = MlistGetFieldNumber(il1, "firing");
784         ilh2         = (int *) (listentry(il1, n));
785         mh2          = ilh2[1];
786         nh2          = ilh2[2];
787         if ((mh * nh) == (mh2 * nh2))
788         {
789             for (j = 0; j < Block.nevout; j++)
790             {
791                 Block.evout[j] = *((double *)(&ilh2[4]) + j);
792             }
793         }
794         else
795         {
796             for (j = 0; j < Block.nevout; j++)
797             {
798                 Block.evout[j] = -1.0;
799             }
800         }
801     }
802
803     /* continuous state  */
804     /* 11 : model.state  */
805     n            = MlistGetFieldNumber(il1, "state");
806     ilh          = (int *) (listentry(il1, n));
807     mh           = ilh[1];
808     nh           = ilh[2];
809     Block.nx     = mh * nh;
810     Block.x      = NULL;
811     Block.xprop  = NULL;
812     Block.xd     = NULL;
813     Block.res    = NULL;
814     if (mh*nh != 0)
815     {
816         /* x */
817         if ((Block.x = (double *) MALLOC(Block.nx * sizeof(double))) == NULL)
818         {
819             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
820             FREE(Block.inptr);
821             FREE(Block.insz);
822             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
823             FREE(Block.outptr);
824             FREE(Block.outsz);
825             FREE(Block.evout);
826             Scierror(888, _("%s : Allocation error.\n"), fname);
827             return 0;
828         }
829
830         for (j = 0; j < Block.nx; j++)
831         {
832             Block.x[j] = *((double *)(&ilh[4]) + j);
833         }
834
835         /* xd */
836         if ((Block.xd = (double *) MALLOC(Block.nx * sizeof(double))) == NULL)
837         {
838             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
839             FREE(Block.inptr);
840             FREE(Block.insz);
841             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
842             FREE(Block.outptr);
843             FREE(Block.outsz);
844             FREE(Block.evout);
845             FREE(Block.x);
846             Scierror(888, _("%s : Allocation error.\n"), fname);
847             return 0;
848         }
849
850         for (j = 0; j < Block.nx; j++)
851         {
852             Block.xd[j] = 0.;
853         }
854         /* xprop */
855         if ((Block.xprop = (int *) MALLOC(Block.nx * sizeof(int))) == NULL)
856         {
857             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
858             FREE(Block.inptr);
859             FREE(Block.insz);
860             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
861             FREE(Block.outptr);
862             FREE(Block.outsz);
863             FREE(Block.evout);
864             FREE(Block.x);
865             FREE(Block.xd);
866             Scierror(888, _("%s : Allocation error.\n"), fname);
867             return 0;
868         }
869
870         for (j = 0; j < Block.nx; j++)
871         {
872             Block.xprop[j] = 1;
873         }
874         /* res */
875         /*if (blktyp>10000) {*/
876         if ((Block.res = (double *) MALLOC(Block.nx * sizeof(double))) == NULL)
877         {
878             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
879             FREE(Block.inptr);
880             FREE(Block.insz);
881             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
882             FREE(Block.outptr);
883             FREE(Block.outsz);
884             FREE(Block.evout);
885             FREE(Block.x);
886             FREE(Block.xd);
887             FREE(Block.xprop);
888             Scierror(888, _("%s : Allocation error.\n"), fname);
889             return 0;
890         }
891
892         for (j = 0; j < Block.nx; j++)
893         {
894             Block.res[j] = 0.;
895         }
896         /*}*/
897     }
898
899     /* discrete state  */
900     /* 12 : model.dstate  */
901     n            = MlistGetFieldNumber(il1, "dstate");
902     ilh          = (int *) (listentry(il1, n));
903     mh           = ilh[1];
904     nh           = ilh[2];
905     Block.nz     = mh * nh;
906     Block.z      = NULL;
907
908     if (mh*nh != 0)
909     {
910         if ((Block.z = (double *) MALLOC(Block.nz * sizeof(double))) == NULL)
911         {
912             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
913             FREE(Block.inptr);
914             FREE(Block.insz);
915             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
916             FREE(Block.outptr);
917             FREE(Block.outsz);
918             FREE(Block.evout);
919             FREE(Block.x);
920             FREE(Block.xd);
921             FREE(Block.xprop);
922             FREE(Block.res);
923             Scierror(888, _("%s : Allocation error.\n"), fname);
924             return 0;
925         }
926
927         for (j = 0; j < Block.nz; j++)
928         {
929             Block.z[j] = *((double *)(&ilh[4]) + j);
930         }
931     }
932
933     /* discrete object state  */
934     /* 13 : model.odstate  */
935     n            = MlistGetFieldNumber(il1, "odstate");
936     ilh          = (int *) (listentry(il1, n));
937     mh           = ilh[1];
938     nh           = ilh[2];
939     Block.noz    = mh * nh;
940     Block.ozsz   = NULL;
941     Block.oztyp  = NULL;
942     Block.ozptr  = NULL;
943     if (mh*nh != 0)
944     {
945         if ((Block.ozsz = (int *) MALLOC(2 * Block.noz * sizeof(int))) == NULL)
946         {
947             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
948             FREE(Block.inptr);
949             FREE(Block.insz);
950             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
951             FREE(Block.outptr);
952             FREE(Block.outsz);
953             FREE(Block.evout);
954             FREE(Block.x);
955             FREE(Block.xd);
956             FREE(Block.xprop);
957             FREE(Block.res);
958             FREE(Block.z);
959             Scierror(888, _("%s : Allocation error.\n"), fname);
960             return 0;
961         }
962
963         if ((Block.oztyp = (int *) MALLOC(Block.noz * sizeof(int))) == NULL)
964         {
965             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
966             FREE(Block.inptr);
967             FREE(Block.insz);
968             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
969             FREE(Block.outptr);
970             FREE(Block.outsz);
971             FREE(Block.evout);
972             FREE(Block.x);
973             FREE(Block.xd);
974             FREE(Block.xprop);
975             FREE(Block.res);
976             FREE(Block.z);
977             FREE(Block.ozsz);
978             Scierror(888, _("%s : Allocation error.\n"), fname);
979             return 0;
980         }
981
982         if ((Block.ozptr = (void **) MALLOC(Block.noz * sizeof(void *))) == NULL)
983         {
984             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
985             FREE(Block.inptr);
986             FREE(Block.insz);
987             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
988             FREE(Block.outptr);
989             FREE(Block.outsz);
990             FREE(Block.evout);
991             FREE(Block.x);
992             FREE(Block.xd);
993             FREE(Block.xprop);
994             FREE(Block.res);
995             FREE(Block.z);
996             FREE(Block.ozsz);
997             FREE(Block.oztyp);
998             Scierror(888, _("%s : Allocation error.\n"), fname);
999             return 0;
1000         }
1001
1002         for (i = 0; i < mh * nh; i++)
1003         {
1004             ilh2 = (int *) (listentry(ilh, i + 1));
1005             mh2  = ilh2[1];
1006             nh2  = ilh2[2];
1007             Block.ozsz[i] = mh2;
1008             Block.ozsz[Block.noz + i] = nh2;
1009             if (ilh2[0] == 1)
1010             {
1011                 if (ilh2[3] == 0)
1012                 {
1013                     Block.oztyp[i] = 10;
1014                     if ((Block.ozptr[i] = (double *) MALLOC(mh2 * nh2 * sizeof(double))) == NULL)
1015                     {
1016                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1017                         FREE(Block.inptr);
1018                         FREE(Block.insz);
1019                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1020                         FREE(Block.outptr);
1021                         FREE(Block.outsz);
1022                         FREE(Block.evout);
1023                         FREE(Block.x);
1024                         FREE(Block.xd);
1025                         FREE(Block.xprop);
1026                         FREE(Block.res);
1027                         FREE(Block.z);
1028                         FREE(Block.ozsz);
1029                         FREE(Block.oztyp);
1030                         for (j = 0; j < i; j++) FREE(Block.ozptr[j]);
1031                         Scierror(888, _("%s : Allocation error.\n"), fname);
1032                         return 0;
1033                     }
1034                     ptr_d = (double *) Block.ozptr[i];
1035                     for (j = 0; j < mh2 * nh2; j++)
1036                     {
1037                         ptr_d[j] = *((double *)(&ilh2[4]) + j);
1038                     }
1039                 }
1040                 else if (ilh2[3] == 1)
1041                 {
1042                     Block.oztyp[i] = 11;
1043                     if ((Block.ozptr[i] = (double *) MALLOC(2 * mh2 * nh2 * sizeof(double))) == NULL)
1044                     {
1045                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1046                         FREE(Block.inptr);
1047                         FREE(Block.insz);
1048                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1049                         FREE(Block.outptr);
1050                         FREE(Block.outsz);
1051                         FREE(Block.evout);
1052                         FREE(Block.x);
1053                         FREE(Block.xd);
1054                         FREE(Block.xprop);
1055                         FREE(Block.res);
1056                         FREE(Block.z);
1057                         FREE(Block.ozsz);
1058                         FREE(Block.oztyp);
1059                         for (j = 0; j < i; j++) FREE(Block.ozptr[j]);
1060                         Scierror(888, _("%s : Allocation error.\n"), fname);
1061                         return 0;
1062                     }
1063                     ptr_d = (double *) Block.ozptr[i];
1064                     for (j = 0; j < 2 * mh2 * nh2; j++)
1065                     {
1066                         ptr_d[j] = *((double *)(&ilh2[4]) + j);
1067                     }
1068                 }
1069             }
1070             else if (ilh2[0] == 8)
1071             {
1072                 if (ilh2[3] == 4)
1073                 {
1074                     Block.oztyp[i] = 84;
1075                     if ((Block.ozptr[i] = (long *) MALLOC(mh2 * nh2 * sizeof(long))) == NULL)
1076                     {
1077                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1078                         FREE(Block.inptr);
1079                         FREE(Block.insz);
1080                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1081                         FREE(Block.outptr);
1082                         FREE(Block.outsz);
1083                         FREE(Block.evout);
1084                         FREE(Block.x);
1085                         FREE(Block.xd);
1086                         FREE(Block.xprop);
1087                         FREE(Block.res);
1088                         FREE(Block.z);
1089                         FREE(Block.ozsz);
1090                         FREE(Block.oztyp);
1091                         for (j = 0; j < i; j++) FREE(Block.ozptr[j]);
1092                         Scierror(888, _("%s : Allocation error.\n"), fname);
1093                         return 0;
1094                     }
1095                     ptr_l = (long *) Block.ozptr[i];
1096                     for (j = 0; j < mh2 * nh2; j++)
1097                     {
1098                         ptr_l[j] = *((long *)(&ilh2[4]) + j);
1099                     }
1100                 }
1101                 else if (ilh2[3] == 2)
1102                 {
1103                     Block.oztyp[i] = 82;
1104                     if ((Block.ozptr[i] = (short *) MALLOC(mh2 * nh2 * sizeof(short))) == NULL)
1105                     {
1106                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1107                         FREE(Block.inptr);
1108                         FREE(Block.insz);
1109                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1110                         FREE(Block.outptr);
1111                         FREE(Block.outsz);
1112                         FREE(Block.evout);
1113                         FREE(Block.x);
1114                         FREE(Block.xd);
1115                         FREE(Block.xprop);
1116                         FREE(Block.res);
1117                         FREE(Block.z);
1118                         FREE(Block.ozsz);
1119                         FREE(Block.oztyp);
1120                         for (j = 0; j < i; j++) FREE(Block.ozptr[j]);
1121                         Scierror(888, _("%s : Allocation error.\n"), fname);
1122                         return 0;
1123                     }
1124                     ptr_s = (short *) Block.ozptr[i];
1125                     for (j = 0; j < mh2 * nh2; j++)
1126                     {
1127                         ptr_s[j] = *((short *)(&ilh2[4]) + j);
1128                     }
1129                 }
1130                 else if (ilh2[3] == 1)
1131                 {
1132                     Block.oztyp[i] = 81;
1133                     if ((Block.ozptr[i] = (char *) MALLOC(mh2 * nh2 * sizeof(char))) == NULL)
1134                     {
1135                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1136                         FREE(Block.inptr);
1137                         FREE(Block.insz);
1138                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1139                         FREE(Block.outptr);
1140                         FREE(Block.outsz);
1141                         FREE(Block.evout);
1142                         FREE(Block.x);
1143                         FREE(Block.xd);
1144                         FREE(Block.xprop);
1145                         FREE(Block.res);
1146                         FREE(Block.z);
1147                         FREE(Block.ozsz);
1148                         FREE(Block.oztyp);
1149                         for (j = 0; j < i; j++) FREE(Block.ozptr[j]);
1150                         Scierror(888, _("%s : Allocation error.\n"), fname);
1151                         return 0;
1152                     }
1153                     ptr_c = (char *) Block.ozptr[i];
1154                     for (j = 0; j < mh2 * nh2; j++)
1155                     {
1156                         ptr_c[j] = *((char *)(&ilh2[4]) + j);
1157                     }
1158                 }
1159                 else if (ilh2[3] == 14)
1160                 {
1161                     Block.oztyp[i] = 814;
1162                     if ((Block.ozptr[i] = (unsigned long *) MALLOC(mh2 * nh2 * sizeof(unsigned long))) == NULL)
1163                     {
1164                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1165                         FREE(Block.inptr);
1166                         FREE(Block.insz);
1167                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1168                         FREE(Block.outptr);
1169                         FREE(Block.outsz);
1170                         FREE(Block.evout);
1171                         FREE(Block.x);
1172                         FREE(Block.xd);
1173                         FREE(Block.xprop);
1174                         FREE(Block.res);
1175                         FREE(Block.z);
1176                         FREE(Block.ozsz);
1177                         FREE(Block.oztyp);
1178                         for (j = 0; j < i; j++) FREE(Block.ozptr[j]);
1179                         Scierror(888, _("%s : Allocation error.\n"), fname);
1180                         return 0;
1181                     }
1182                     ptr_ul = (unsigned long *) Block.ozptr[i];
1183                     for (j = 0; j < mh2 * nh2; j++)
1184                     {
1185                         ptr_ul[j] = *((unsigned long *)(&ilh2[4]) + j);
1186                     }
1187                 }
1188                 else if (ilh2[3] == 12)
1189                 {
1190                     Block.oztyp[i] = 812;
1191                     if ((Block.ozptr[i] = (unsigned short *) MALLOC(mh2 * nh2 * sizeof(unsigned short))) == NULL)
1192                     {
1193                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1194                         FREE(Block.inptr);
1195                         FREE(Block.insz);
1196                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1197                         FREE(Block.outptr);
1198                         FREE(Block.outsz);
1199                         FREE(Block.evout);
1200                         FREE(Block.x);
1201                         FREE(Block.xd);
1202                         FREE(Block.xprop);
1203                         FREE(Block.res);
1204                         FREE(Block.z);
1205                         FREE(Block.ozsz);
1206                         FREE(Block.oztyp);
1207                         for (j = 0; j < i; j++) FREE(Block.ozptr[j]);
1208                         Scierror(888, _("%s : Allocation error.\n"), fname);
1209                         return 0;
1210                     }
1211                     ptr_us = (unsigned short *) Block.ozptr[i];
1212                     for (j = 0; j < mh2 * nh2; j++)
1213                     {
1214                         ptr_us[j] = *((unsigned short *)(&ilh2[4]) + j);
1215                     }
1216                 }
1217                 else if (ilh2[3] == 11)
1218                 {
1219                     Block.oztyp[i] = 811;
1220                     if ((Block.ozptr[i] = (unsigned char *) MALLOC(mh2 * nh2 * sizeof(unsigned char))) == NULL)
1221                     {
1222                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1223                         FREE(Block.inptr);
1224                         FREE(Block.insz);
1225                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1226                         FREE(Block.outptr);
1227                         FREE(Block.outsz);
1228                         FREE(Block.evout);
1229                         FREE(Block.x);
1230                         FREE(Block.xd);
1231                         FREE(Block.xprop);
1232                         FREE(Block.res);
1233                         FREE(Block.z);
1234                         FREE(Block.ozsz);
1235                         FREE(Block.oztyp);
1236                         for (j = 0; j < i; j++) FREE(Block.ozptr[j]);
1237                         Scierror(888, _("%s : Allocation error.\n"), fname);
1238                         return 0;
1239                     }
1240                     ptr_uc = (unsigned char *) Block.ozptr[i];
1241                     for (j = 0; j < mh2 * nh2; j++)
1242                     {
1243                         ptr_uc[j] = *((unsigned char *)(&ilh2[4]) + j);
1244                     }
1245                 }
1246             }
1247         }
1248     }
1249
1250     /* real parameters */
1251     /* 14 : model.rpar  */
1252     n            = MlistGetFieldNumber(il1, "rpar");
1253     ilh          = (int *) (listentry(il1, n));
1254     mh           = ilh[1];
1255     nh           = ilh[2];
1256     Block.nrpar  = mh * nh;
1257     Block.rpar   = NULL;
1258     if (mh*nh != 0)
1259     {
1260         if ((Block.rpar = (double *) MALLOC(Block.nrpar * sizeof(double))) == NULL)
1261         {
1262             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1263             FREE(Block.inptr);
1264             FREE(Block.insz);
1265             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1266             FREE(Block.outptr);
1267             FREE(Block.outsz);
1268             FREE(Block.evout);
1269             FREE(Block.x);
1270             FREE(Block.xd);
1271             FREE(Block.xprop);
1272             FREE(Block.res);
1273             FREE(Block.z);
1274             FREE(Block.ozsz);
1275             FREE(Block.oztyp);
1276             for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1277             Scierror(888, _("%s : Allocation error.\n"), fname);
1278             return 0;
1279         }
1280         for (j = 0; j < Block.nrpar; j++)
1281         {
1282             Block.rpar[j] = *((double *)(&ilh[4]) + j);
1283         }
1284     }
1285
1286     /* integer parameters */
1287     /* 15 : model.ipar  */
1288     n            = MlistGetFieldNumber(il1, "ipar");
1289     ilh          = (int *) (listentry(il1, n));
1290     mh           = ilh[1];
1291     nh           = ilh[2];
1292     Block.nipar  = mh * nh;
1293     Block.ipar   = NULL;
1294     if (mh*nh != 0)
1295     {
1296         if ((Block.ipar = (int *) MALLOC(Block.nipar * sizeof(int))) == NULL)
1297         {
1298             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1299             FREE(Block.inptr);
1300             FREE(Block.insz);
1301             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1302             FREE(Block.outptr);
1303             FREE(Block.outsz);
1304             FREE(Block.evout);
1305             FREE(Block.x);
1306             FREE(Block.xd);
1307             FREE(Block.xprop);
1308             FREE(Block.res);
1309             FREE(Block.z);
1310             FREE(Block.ozsz);
1311             FREE(Block.oztyp);
1312             for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1313             FREE(Block.rpar);
1314             Scierror(888, _("%s : Allocation error.\n"), fname);
1315             return 0;
1316         }
1317
1318         for (j = 0; j < Block.nipar; j++)
1319         {
1320             Block.ipar[j] = (int) * ((double *)(&ilh[4]) + j);
1321         }
1322     }
1323
1324     /* object parameters */
1325     /* 16 : model.opar  */
1326     n             = MlistGetFieldNumber(il1, "opar");
1327     ilh           = (int *) (listentry(il1, n));
1328     mh            = ilh[1];
1329     nh            = ilh[2];
1330     Block.nopar   = mh * nh;
1331     Block.oparsz  = NULL;
1332     Block.opartyp = NULL;
1333     Block.oparptr = NULL;
1334     if (mh*nh != 0)
1335     {
1336         if ((Block.oparsz = (int *) MALLOC(2 * Block.nopar * sizeof(int))) == NULL)
1337         {
1338             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1339             FREE(Block.inptr);
1340             FREE(Block.insz);
1341             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1342             FREE(Block.outptr);
1343             FREE(Block.outsz);
1344             FREE(Block.evout);
1345             FREE(Block.x);
1346             FREE(Block.xd);
1347             FREE(Block.xprop);
1348             FREE(Block.res);
1349             FREE(Block.z);
1350             FREE(Block.ozsz);
1351             FREE(Block.oztyp);
1352             for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1353             FREE(Block.rpar);
1354             FREE(Block.ipar);
1355             Scierror(888, _("%s : Allocation error.\n"), fname);
1356             return 0;
1357         }
1358
1359         if ((Block.opartyp = (int *) MALLOC(Block.nopar * sizeof(int))) == NULL)
1360         {
1361             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1362             FREE(Block.inptr);
1363             FREE(Block.insz);
1364             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1365             FREE(Block.outptr);
1366             FREE(Block.outsz);
1367             FREE(Block.evout);
1368             FREE(Block.x);
1369             FREE(Block.xd);
1370             FREE(Block.xprop);
1371             FREE(Block.res);
1372             FREE(Block.z);
1373             FREE(Block.ozsz);
1374             FREE(Block.oztyp);
1375             for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1376             FREE(Block.rpar);
1377             FREE(Block.ipar);
1378             FREE(Block.oparsz);
1379             Scierror(888, _("%s : Allocation error.\n"), fname);
1380             return 0;
1381         }
1382
1383         if ((Block.oparptr = (void **) MALLOC(Block.nopar * sizeof(void *))) == NULL)
1384         {
1385             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1386             FREE(Block.inptr);
1387             FREE(Block.insz);
1388             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1389             FREE(Block.outptr);
1390             FREE(Block.outsz);
1391             FREE(Block.evout);
1392             FREE(Block.x);
1393             FREE(Block.xd);
1394             FREE(Block.xprop);
1395             FREE(Block.res);
1396             FREE(Block.z);
1397             FREE(Block.ozsz);
1398             FREE(Block.oztyp);
1399             for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1400             FREE(Block.rpar);
1401             FREE(Block.ipar);
1402             FREE(Block.oparsz);
1403             FREE(Block.opartyp);
1404             Scierror(888, _("%s : Allocation error.\n"), fname);
1405             return 0;
1406         }
1407
1408         for (i = 0; i < mh * nh; i++)
1409         {
1410             ilh2 = (int *) (listentry(ilh, i + 1));
1411             mh2  = ilh2[1];
1412             nh2  = ilh2[2];
1413             Block.oparsz[i] = mh2;
1414             Block.oparsz[Block.nopar + i] = nh2;
1415             if (ilh2[0] == 1)
1416             {
1417                 if (ilh2[3] == 0)
1418                 {
1419                     Block.opartyp[i] = 10;
1420                     if ((Block.oparptr[i] = (double *) MALLOC(mh2 * nh2 * sizeof(double))) == NULL)
1421                     {
1422                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1423                         FREE(Block.inptr);
1424                         FREE(Block.insz);
1425                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1426                         FREE(Block.outptr);
1427                         FREE(Block.outsz);
1428                         FREE(Block.evout);
1429                         FREE(Block.x);
1430                         FREE(Block.xd);
1431                         FREE(Block.xprop);
1432                         FREE(Block.res);
1433                         FREE(Block.z);
1434                         FREE(Block.ozsz);
1435                         FREE(Block.oztyp);
1436                         for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1437                         FREE(Block.rpar);
1438                         FREE(Block.ipar);
1439                         FREE(Block.oparsz);
1440                         FREE(Block.opartyp);
1441                         for (j = 0; j < i; j++) FREE(Block.oparptr[j]);
1442                         Scierror(888, _("%s : Allocation error.\n"), fname);
1443                         return 0;
1444                     }
1445                     ptr_d = (double *) Block.oparptr[i];
1446                     for (j = 0; j < mh2 * nh2; j++)
1447                     {
1448                         ptr_d[j] = *((double *)(&ilh2[4]) + j);
1449                     }
1450                 }
1451                 else if (ilh2[3] == 1)
1452                 {
1453                     Block.opartyp[i] = 11;
1454                     if ((Block.oparptr[i] = (double *) MALLOC(2 * mh2 * nh2 * sizeof(double))) == NULL)
1455                     {
1456                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1457                         FREE(Block.inptr);
1458                         FREE(Block.insz);
1459                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1460                         FREE(Block.outptr);
1461                         FREE(Block.outsz);
1462                         FREE(Block.evout);
1463                         FREE(Block.x);
1464                         FREE(Block.xd);
1465                         FREE(Block.xprop);
1466                         FREE(Block.res);
1467                         FREE(Block.z);
1468                         FREE(Block.ozsz);
1469                         FREE(Block.oztyp);
1470                         for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1471                         FREE(Block.rpar);
1472                         FREE(Block.ipar);
1473                         FREE(Block.oparsz);
1474                         FREE(Block.opartyp);
1475                         for (j = 0; j < i; j++) FREE(Block.oparptr[j]);
1476                         Scierror(888, _("%s : Allocation error.\n"), fname);
1477                         return 0;
1478                     }
1479
1480                     ptr_d = (double *) Block.oparptr[i];
1481                     for (j = 0; j < 2 * mh2 * nh2; j++)
1482                     {
1483                         ptr_d[j] = *((double *)(&ilh2[4]) + j);
1484                     }
1485                 }
1486             }
1487             else if (ilh2[0] == 8)
1488             {
1489                 if (ilh2[3] == 4)
1490                 {
1491                     Block.opartyp[i] = 84;
1492                     if ((Block.oparptr[i] = (long *) MALLOC(mh2 * nh2 * sizeof(long))) == NULL)
1493                     {
1494                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1495                         FREE(Block.inptr);
1496                         FREE(Block.insz);
1497                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1498                         FREE(Block.outptr);
1499                         FREE(Block.outsz);
1500                         FREE(Block.evout);
1501                         FREE(Block.x);
1502                         FREE(Block.xd);
1503                         FREE(Block.xprop);
1504                         FREE(Block.res);
1505                         FREE(Block.z);
1506                         FREE(Block.ozsz);
1507                         FREE(Block.oztyp);
1508                         for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1509                         FREE(Block.rpar);
1510                         FREE(Block.ipar);
1511                         FREE(Block.oparsz);
1512                         FREE(Block.opartyp);
1513                         for (j = 0; j < i; j++) FREE(Block.oparptr[j]);
1514                         Scierror(888, _("%s : Allocation error.\n"), fname);
1515                         return 0;
1516                     }
1517                     ptr_l = (long *) Block.oparptr[i];
1518                     for (j = 0; j < mh2 * nh2; j++)
1519                     {
1520                         ptr_l[j] = *((long *)(&ilh2[4]) + j);
1521                     }
1522                 }
1523                 else if (ilh2[3] == 2)
1524                 {
1525                     Block.opartyp[i] = 82;
1526                     if ((Block.oparptr[i] = (short *) MALLOC(mh2 * nh2 * sizeof(short))) == NULL)
1527                     {
1528                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1529                         FREE(Block.inptr);
1530                         FREE(Block.insz);
1531                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1532                         FREE(Block.outptr);
1533                         FREE(Block.outsz);
1534                         FREE(Block.evout);
1535                         FREE(Block.x);
1536                         FREE(Block.xd);
1537                         FREE(Block.xprop);
1538                         FREE(Block.res);
1539                         FREE(Block.z);
1540                         FREE(Block.ozsz);
1541                         FREE(Block.oztyp);
1542                         for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1543                         FREE(Block.rpar);
1544                         FREE(Block.ipar);
1545                         FREE(Block.oparsz);
1546                         FREE(Block.opartyp);
1547                         for (j = 0; j < i; j++) FREE(Block.oparptr[j]);
1548                         Scierror(888, _("%s : Allocation error.\n"), fname);
1549                         return 0;
1550                     }
1551                     ptr_s = (short *) Block.oparptr[i];
1552                     for (j = 0; j < mh2 * nh2; j++)
1553                     {
1554                         ptr_s[j] = *((short *)(&ilh2[4]) + j);
1555                     }
1556                 }
1557                 else if (ilh2[3] == 1)
1558                 {
1559                     Block.opartyp[i] = 81;
1560                     if ((Block.oparptr[i] = (char *) MALLOC(mh2 * nh2 * sizeof(char))) == NULL)
1561                     {
1562                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1563                         FREE(Block.inptr);
1564                         FREE(Block.insz);
1565                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1566                         FREE(Block.outptr);
1567                         FREE(Block.outsz);
1568                         FREE(Block.evout);
1569                         FREE(Block.x);
1570                         FREE(Block.xd);
1571                         FREE(Block.xprop);
1572                         FREE(Block.res);
1573                         FREE(Block.z);
1574                         FREE(Block.ozsz);
1575                         FREE(Block.oztyp);
1576                         for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1577                         FREE(Block.rpar);
1578                         FREE(Block.ipar);
1579                         FREE(Block.oparsz);
1580                         FREE(Block.opartyp);
1581                         for (j = 0; j < i; j++) FREE(Block.oparptr[j]);
1582                         Scierror(888, _("%s : Allocation error.\n"), fname);
1583                         return 0;
1584                     }
1585                     ptr_c = (char *) Block.oparptr[i];
1586                     for (j = 0; j < mh2 * nh2; j++)
1587                     {
1588                         ptr_c[j] = *((char *)(&ilh2[4]) + j);
1589                     }
1590                 }
1591                 else if (ilh2[3] == 14)
1592                 {
1593                     Block.opartyp[i] = 814;
1594                     if ((Block.oparptr[i] = (unsigned long *) MALLOC(mh2 * nh2 * sizeof(unsigned long))) == NULL)
1595                     {
1596                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1597                         FREE(Block.inptr);
1598                         FREE(Block.insz);
1599                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1600                         FREE(Block.outptr);
1601                         FREE(Block.outsz);
1602                         FREE(Block.evout);
1603                         FREE(Block.x);
1604                         FREE(Block.xd);
1605                         FREE(Block.xprop);
1606                         FREE(Block.res);
1607                         FREE(Block.z);
1608                         FREE(Block.ozsz);
1609                         FREE(Block.oztyp);
1610                         for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1611                         FREE(Block.rpar);
1612                         FREE(Block.ipar);
1613                         FREE(Block.oparsz);
1614                         FREE(Block.opartyp);
1615                         for (j = 0; j < i; j++) FREE(Block.oparptr[j]);
1616                         Scierror(888, _("%s : Allocation error.\n"), fname);
1617                         return 0;
1618                     }
1619                     ptr_ul = (unsigned long *) Block.oparptr[i];
1620                     for (j = 0; j < mh2 * nh2; j++)
1621                     {
1622                         ptr_ul[j] = *((unsigned long *)(&ilh2[4]) + j);
1623                     }
1624                 }
1625                 else if (ilh2[3] == 12)
1626                 {
1627                     Block.opartyp[i] = 812;
1628                     if ((Block.oparptr[i] = (unsigned short *) MALLOC(mh2 * nh2 * sizeof(unsigned short))) == NULL)
1629                     {
1630                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1631                         FREE(Block.inptr);
1632                         FREE(Block.insz);
1633                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1634                         FREE(Block.outptr);
1635                         FREE(Block.outsz);
1636                         FREE(Block.evout);
1637                         FREE(Block.x);
1638                         FREE(Block.xd);
1639                         FREE(Block.xprop);
1640                         FREE(Block.res);
1641                         FREE(Block.z);
1642                         FREE(Block.ozsz);
1643                         FREE(Block.oztyp);
1644                         for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1645                         FREE(Block.rpar);
1646                         FREE(Block.ipar);
1647                         FREE(Block.oparsz);
1648                         FREE(Block.opartyp);
1649                         for (j = 0; j < i; j++) FREE(Block.oparptr[j]);
1650                         Scierror(888, _("%s : Allocation error.\n"), fname);
1651                         return 0;
1652                     }
1653                     ptr_us = (unsigned short *) Block.oparptr[i];
1654                     for (j = 0; j < mh2 * nh2; j++)
1655                     {
1656                         ptr_us[j] = *((unsigned short *)(&ilh2[4]) + j);
1657                     }
1658                 }
1659                 else if (ilh2[3] == 11)
1660                 {
1661                     Block.opartyp[i] = 811;
1662                     if ((Block.oparptr[i] = (unsigned char *) MALLOC(mh2 * nh2 * sizeof(unsigned char))) == NULL)
1663                     {
1664                         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1665                         FREE(Block.inptr);
1666                         FREE(Block.insz);
1667                         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1668                         FREE(Block.outptr);
1669                         FREE(Block.outsz);
1670                         FREE(Block.evout);
1671                         FREE(Block.x);
1672                         FREE(Block.xd);
1673                         FREE(Block.xprop);
1674                         FREE(Block.res);
1675                         FREE(Block.z);
1676                         FREE(Block.ozsz);
1677                         FREE(Block.oztyp);
1678                         for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1679                         FREE(Block.rpar);
1680                         FREE(Block.ipar);
1681                         FREE(Block.oparsz);
1682                         FREE(Block.opartyp);
1683                         for (j = 0; j < i; j++) FREE(Block.oparptr[j]);
1684                         Scierror(888, _("%s : Allocation error.\n"), fname);
1685                         return 0;
1686                     }
1687                     ptr_uc = (unsigned char *) Block.oparptr[i];
1688                     for (j = 0; j < mh2 * nh2; j++)
1689                     {
1690                         ptr_uc[j] = *((unsigned char *)(&ilh2[4]) + j);
1691                     }
1692                 }
1693             }
1694         }
1695     }
1696
1697     /* labels */
1698     /* 20 : model.label  */
1699     n            = MlistGetFieldNumber(il1, "label");
1700     ilh          = (int *) (listentry(il1, n));
1701     mh           = ilh[1];
1702     nh           = ilh[2];
1703     Block.label  = "";
1704     if (mh*nh != 0)
1705     {
1706         len_str  = ilh[5] - 1;
1707         if (len_str != 0)
1708         {
1709             if ((Block.label = (char *) MALLOC((len_str + 1) * sizeof(char))) == NULL)
1710             {
1711                 for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1712                 FREE(Block.inptr);
1713                 FREE(Block.insz);
1714                 for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1715                 FREE(Block.outptr);
1716                 FREE(Block.outsz);
1717                 FREE(Block.evout);
1718                 FREE(Block.x);
1719                 FREE(Block.xd);
1720                 FREE(Block.xprop);
1721                 FREE(Block.res);
1722                 FREE(Block.z);
1723                 FREE(Block.ozsz);
1724                 FREE(Block.oztyp);
1725                 for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1726                 FREE(Block.rpar);
1727                 FREE(Block.ipar);
1728                 FREE(Block.oparsz);
1729                 FREE(Block.opartyp);
1730                 for (j = 0; j < Block.nopar; j++) FREE(Block.oparptr[j]);
1731                 Scierror(888, _("%s : Allocation error.\n"), fname);
1732                 return 0;
1733             }
1734             Block.label[len_str] = '\0';
1735             C2F(cvstr)(&len_str, &ilh[6], Block.label, (j = 1, &j), len_str);
1736         }
1737     }
1738
1739     /* zero crossing */
1740     /* 21 : model.nzcross  */
1741     n            = MlistGetFieldNumber(il1, "nzcross");
1742     ilh          = (int *) (listentry(il1, n));
1743     mh           = ilh[1];
1744     nh           = ilh[2];
1745     Block.ng     = (int) * ((double *)(&ilh[4]));
1746     Block.g      = NULL;
1747     Block.jroot  = NULL;
1748     if (Block.ng != 0)
1749     {
1750         if ((Block.g = (double *) MALLOC(Block.ng * sizeof(double))) == NULL)
1751         {
1752             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1753             FREE(Block.inptr);
1754             FREE(Block.insz);
1755             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1756             FREE(Block.outptr);
1757             FREE(Block.outsz);
1758             FREE(Block.evout);
1759             FREE(Block.x);
1760             FREE(Block.xd);
1761             FREE(Block.res);
1762             FREE(Block.xprop);
1763             FREE(Block.z);
1764             FREE(Block.ozsz);
1765             FREE(Block.oztyp);
1766             for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1767             FREE(Block.rpar);
1768             FREE(Block.ipar);
1769             FREE(Block.oparsz);
1770             FREE(Block.opartyp);
1771             for (j = 0; j < Block.nopar; j++) FREE(Block.oparptr[j]);
1772             FREE(Block.label);
1773             Scierror(888, _("%s : Allocation error.\n"), fname);
1774             return 0;
1775         }
1776
1777         for (j = 0; j < Block.ng; j++)
1778         {
1779             Block.g[j] = 0.;
1780         }
1781         if ((Block.jroot = (int *) MALLOC(Block.ng * sizeof(int))) == NULL)
1782         {
1783             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1784             FREE(Block.inptr);
1785             FREE(Block.insz);
1786             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1787             FREE(Block.outptr);
1788             FREE(Block.outsz);
1789             FREE(Block.evout);
1790             FREE(Block.x);
1791             FREE(Block.xd);
1792             FREE(Block.res);
1793             FREE(Block.xprop);
1794             FREE(Block.z);
1795             FREE(Block.ozsz);
1796             FREE(Block.oztyp);
1797             for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1798             FREE(Block.rpar);
1799             FREE(Block.ipar);
1800             FREE(Block.oparsz);
1801             FREE(Block.opartyp);
1802             for (j = 0; j < Block.nopar; j++) FREE(Block.oparptr[j]);
1803             FREE(Block.label);
1804             FREE(Block.g);
1805             Scierror(888, _("%s : Allocation error.\n"), fname);
1806             return 0;
1807         }
1808
1809         for (j = 0; j < Block.ng; j++)
1810         {
1811             Block.jroot[j] = 0;
1812         }
1813     }
1814
1815     /* mode */
1816     /* 22 : model.nmode  */
1817     n            = MlistGetFieldNumber(il1, "nmode");
1818     ilh          = (int *) (listentry(il1, n));
1819     mh           = ilh[1];
1820     nh           = ilh[2];
1821     Block.nmode  = (int) * ((double *)(&ilh[4]));
1822     Block.mode  = NULL;
1823     if (Block.nmode != 0)
1824     {
1825         if ((Block.mode = (int *) MALLOC(Block.nmode * sizeof(double))) == NULL)
1826         {
1827             for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1828             FREE(Block.inptr);
1829             FREE(Block.insz);
1830             for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1831             FREE(Block.outptr);
1832             FREE(Block.outsz);
1833             FREE(Block.evout);
1834             FREE(Block.x);
1835             FREE(Block.xd);
1836             FREE(Block.res);
1837             FREE(Block.xprop);
1838             FREE(Block.z);
1839             FREE(Block.ozsz);
1840             FREE(Block.oztyp);
1841             for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1842             FREE(Block.rpar);
1843             FREE(Block.ipar);
1844             FREE(Block.oparsz);
1845             FREE(Block.opartyp);
1846             for (j = 0; j < Block.nopar; j++) FREE(Block.oparptr[j]);
1847             FREE(Block.label);
1848             FREE(Block.g);
1849             FREE(Block.jroot);
1850             Scierror(888, _("%s : Allocation error.\n"), fname);
1851             return 0;
1852         }
1853
1854         for (j = 0; j < Block.nmode; j++)
1855         {
1856             Block.mode[j] = 0;
1857         }
1858     }
1859
1860     /* work */
1861     if ((Block.work = (void **) MALLOC(sizeof(void *))) == NULL)
1862     {
1863         for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1864         FREE(Block.inptr);
1865         FREE(Block.insz);
1866         for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1867         FREE(Block.outptr);
1868         FREE(Block.outsz);
1869         FREE(Block.evout);
1870         FREE(Block.x);
1871         FREE(Block.xd);
1872         FREE(Block.res);
1873         FREE(Block.xprop);
1874         FREE(Block.z);
1875         FREE(Block.ozsz);
1876         FREE(Block.oztyp);
1877         for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1878         FREE(Block.rpar);
1879         FREE(Block.ipar);
1880         FREE(Block.oparsz);
1881         FREE(Block.opartyp);
1882         for (j = 0; j < Block.nopar; j++) FREE(Block.oparptr[j]);
1883         FREE(Block.label);
1884         FREE(Block.g);
1885         FREE(Block.jroot);
1886         FREE(Block.mode);
1887         Scierror(888, _("%s : Allocation error.\n"), fname);
1888         return 0;
1889     }
1890     *Block.work = NULL;
1891
1892     TopSave = Top;
1893
1894     ierr = createblklist(&Block, &ierr, -1, Block.type);
1895
1896     for (j = 0; j < Block.nin; j++) FREE(Block.inptr[j]);
1897     FREE(Block.inptr);
1898     FREE(Block.insz);
1899     for (j = 0; j < Block.nout; j++) FREE(Block.outptr[j]);
1900     FREE(Block.outptr);
1901     FREE(Block.outsz);
1902     FREE(Block.evout);
1903     FREE(Block.x);
1904     FREE(Block.xd);
1905     FREE(Block.res);
1906     FREE(Block.z);
1907     FREE(Block.ozsz);
1908     FREE(Block.oztyp);
1909     for (j = 0; j < Block.noz; j++) FREE(Block.ozptr[j]);
1910     FREE(Block.rpar);
1911     FREE(Block.ipar);
1912     FREE(Block.oparsz);
1913     FREE(Block.opartyp);
1914     for (j = 0; j < Block.nopar; j++) FREE(Block.oparptr[j]);
1915     if (len_str != 0) FREE(Block.label);
1916     FREE(Block.g);
1917     FREE(Block.jroot);
1918     FREE(Block.mode);
1919     Top = TopSave;
1920
1921     CreateVar(2, TYPED_LIST_DATATYPE, &nblklst, (j = 1, &j), &l_tmp);
1922     LhsVar(1) = 2;
1923     PutLhsVar();
1924
1925     return 0;
1926 }
1927 /*--------------------------------------------------------------------------*/