3 * Copyright (C) INRIA -
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.
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.
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.
19 * See the file ./license.txt
21 /*--------------------------------------------------------------------------*/
23 #include "gw_scicos.h"
26 #include "localization.h"
27 #include "scicos_block4.h"
32 #include "MlistGetFieldNumber.h"
33 #include "dynamic_link.h"
34 #include "createblklist.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 /*--------------------------------------------------------------------------*/
43 extern OpTab tabsim[];
44 /*--------------------------------------------------------------------------*/
45 /* model2blk Build a scicos_block structure from
48 * [Block] = model2blk(objs.model)
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 !
60 * - 8 : model.outtyp :
62 * - 10 : model.evtout :
63 * - 11 : model.state :
64 * - 12 : model.dsate :
65 * - 13 : model.odsate :
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 :
77 * lhs 1 : a scicos block Tlist
79 * initial rev 12/11/07, Alan
80 * 05/07/08, Alan : fix for xprop
82 * check in/out size and type
85 int sci_model2blk(char *fname, unsigned long fname_len)
109 double *ptr_d = NULL;
111 unsigned char *ptr_uc = NULL;
113 unsigned short *ptr_us = NULL;
114 SCSINT32_COP *ptr_l = NULL;
115 SCSUINT32_COP *ptr_ul = NULL;
119 memset(&Block, 0, sizeof(scicos_block));
123 /* check size of rhs/lhs parameters */
127 il1 = (int *) GetData(1);
131 /* check for a tlist */
132 if (il1[0] != sci_mlist)
134 Scierror(888, _("%s : First argument must be a Typed list.\n"), fname);
138 /* check for a type "scicos model" */
139 ilh = (int *) (listentry(il1, 1));
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))
148 Scierror(888, _("%s : First argument must be a scicos model.\n"), fname);
154 n = MlistGetFieldNumber(il1, "sim");
155 ilh = (int *) (listentry(il1, n));
158 if (ilh[0] == sci_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 */
173 /* check if typfsim is a scilab function */
174 if ((typfsim == sci_u_function) || (typfsim == sci_c_function))
179 /* check if typfsim is a string */
180 else if (typfsim == sci_strings)
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);
194 C2F(namstr)(id, &il_sim[6], &len_str, (j = 0, &j));
197 if ((C2F(com).fun == -1) | (C2F(com).fun == -2))
199 lfunpt = -*Lstk(C2F(com).fin);
204 Scierror(888, _("%s : unknown block : %s\n"), fname, C2F(cha1).buf);
212 /* comput func is a scilab function */
218 Block.funpt = F2C(sciblk);
221 Scierror(888, _("%s : type 1 function not allowed for scilab blocks\n"), fname);
224 Scierror(888, _("%s : type 2 function not allowed for scilab blocks\n"), fname);
227 Block.funpt = sciblk2;
231 Block.funpt = sciblk4;
234 case 99: /* debugging block */
235 Block.funpt = sciblk4;
239 Block.funpt = sciblk4;
243 Scierror(888, _("%s : Undefined Function type\n"), fname);
246 Block.scsptr = -lfunpt;
248 else if (lfunpt <= ntabsim)
250 Block.funpt = *(tabsim[lfunpt - 1].fonc);
255 lfunpt -= (ntabsim + 1);
256 GetDynFunc(lfunpt, &Block.funpt);
257 if (Block.funpt == (voidf) 0)
259 Scierror(888, _("%s : Function not found\n"), fname);
265 /* check input ports */
267 n = MlistGetFieldNumber(il1, "in");
268 ilh = (int *) (listentry(il1, n));
276 /* check value of in */
277 for (i = 0; i < Block.nin; i++)
279 if ((*((double *)(&ilh[4]) + i)) <= 0.)
281 Scierror(888, _("%s : Undetermined Size. in(%d)=%d. Please adjust your model.\n"), \
282 fname, i + 1, (int)(*((double *)(&ilh[4]) + i)));
287 if ((Block.insz = (int *) MALLOC(Block.nin * 3 * sizeof(int))) == NULL)
289 Scierror(888, _("%s : Allocation error.\n"), fname);
293 if ((Block.inptr = (void **) MALLOC(Block.nin * sizeof(void *))) == NULL)
296 Scierror(888, _("%s : Allocation error.\n"), fname);
300 n = MlistGetFieldNumber(il1, "in2");
301 ilh2 = (int *) (listentry(il1, n));
304 /* check value of in2 */
305 for (i = 0; i < (mh2 * nh2); i++)
307 if ((*((double *)(&ilh2[4]) + i)) <= 0.)
309 Scierror(888, _("%s : Undetermined Size. in2(%d)=%d. Please adjust your model.\n"), \
310 fname, i + 1, (int)(*((double *)(&ilh2[4]) + i)));
316 /* 5 : model.intyp */
317 n = MlistGetFieldNumber(il1, "intyp");
318 ilh3 = (int *) (listentry(il1, n));
321 /* check value of intyp */
322 for (i = 0; i < (mh3 * nh3); i++)
324 if ((*((double *)(&ilh3[4]) + i)) <= 0.)
326 Scierror(888, _("%s : Undetermined Type. intyp(%d)=%d. Please adjust your model.\n"), \
327 fname, i + 1, (int)(*((double *)(&ilh3[4]) + i)));
333 if (((mh * nh) == (mh2 * nh2)) && (((mh * nh) == (mh3 * nh3))))
335 for (i = 0; i < Block.nin; i++)
337 Block.insz[i] = (int) * ((double *)(&ilh[4]) + i);
338 Block.insz[Block.nin + i] = (int) * ((double *)(&ilh2[4]) + i);
339 type = *((double *)(&ilh3[4]) + i);
342 Block.insz[2 * Block.nin + i] = 10;
346 Block.insz[2 * Block.nin + i] = 11;
350 Block.insz[2 * Block.nin + i] = 84;
354 Block.insz[2 * Block.nin + i] = 82;
358 Block.insz[2 * Block.nin + i] = 81;
362 Block.insz[2 * Block.nin + i] = 814;
366 Block.insz[2 * Block.nin + i] = 812;
370 Block.insz[2 * Block.nin + i] = 811;
374 Block.insz[2 * Block.nin + i] = 10;
380 for (i = 0; i < Block.nin; i++)
382 Block.insz[i] = (int) * ((double *)(&ilh[4]) + i);
383 Block.insz[Block.nin + i] = 1;
384 Block.insz[2 * Block.nin + i] = 10;
388 for (i = 0; i < Block.nin; i++)
390 switch (Block.insz[2 * Block.nin + i])
393 if ((Block.inptr[i] = (double *) MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(double))) == NULL)
395 for (j = 0; j < i; j++)
397 FREE(Block.inptr[j]);
401 Scierror(888, _("%s : Allocation error.\n"), fname);
404 ptr_d = (double *) Block.inptr[i];
405 for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
411 if ((Block.inptr[i] = (double *) \
412 MALLOC(2 * Block.insz[i] * Block.insz[Block.nin + i] * sizeof(double))) == NULL)
414 for (j = 0; j < i; j++)
416 FREE(Block.inptr[j]);
420 Scierror(888, _("%s : Allocation error.\n"), fname);
423 ptr_d = (double *) Block.inptr[i];
424 for (j = 0; j < 2 * Block.insz[i]*Block.insz[Block.nin + i]; j++)
430 if ((Block.inptr[i] = (SCSINT32_COP *) \
431 MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(SCSINT32_COP))) == NULL)
433 for (j = 0; j < i; j++)
435 FREE(Block.inptr[j]);
439 Scierror(888, _("%s : Allocation error.\n"), fname);
442 ptr_l = (SCSINT32_COP *) Block.inptr[i];
443 for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
449 if ((Block.inptr[i] = (short *) \
450 MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(short))) == NULL)
452 for (j = 0; j < i; j++)
454 FREE(Block.inptr[j]);
458 Scierror(888, _("%s : Allocation error.\n"), fname);
461 ptr_s = (short *) Block.inptr[i];
462 for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
468 if ((Block.inptr[i] = (char *) \
469 MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(char))) == NULL)
471 for (j = 0; j < i; j++)
473 FREE(Block.inptr[j]);
477 Scierror(888, _("%s : Allocation error.\n"), fname);
480 ptr_c = (char *) Block.inptr[i];
481 for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
487 if ((Block.inptr[i] = (SCSUINT32_COP *) \
488 MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(SCSUINT32_COP))) == NULL)
490 for (j = 0; j < i; j++)
492 FREE(Block.inptr[j]);
496 Scierror(888, _("%s : Allocation error.\n"), fname);
499 ptr_ul = (SCSUINT32_COP *) Block.inptr[i];
500 for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
506 if ((Block.inptr[i] = (unsigned short *) \
507 MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(unsigned short))) == NULL)
509 for (j = 0; j < i; j++)
511 FREE(Block.inptr[j]);
515 Scierror(888, _("%s : Allocation error.\n"), fname);
518 ptr_us = (unsigned short *) Block.inptr[i];
519 for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
525 if ((Block.inptr[i] = (unsigned char *) \
526 MALLOC(Block.insz[i] * Block.insz[Block.nin + i] * sizeof(unsigned char))) == NULL)
528 for (j = 0; j < i; j++)
530 FREE(Block.inptr[j]);
534 Scierror(888, _("%s : Allocation error.\n"), fname);
537 ptr_uc = (unsigned char *) Block.inptr[i];
538 for (j = 0; j < Block.insz[i]*Block.insz[Block.nin + i]; j++)
547 /* check output ports */
549 n = MlistGetFieldNumber(il1, "out");
550 ilh = (int *) (listentry(il1, n));
553 Block.nout = mh * nh;
558 /* check value of out */
559 for (i = 0; i < Block.nout; i++)
561 if ((*((double *)(&ilh[4]) + i)) <= 0.)
563 Scierror(888, _("%s : Undetermined Size. out(%d)=%d. Please adjust your model.\n"), \
564 fname, i + 1, (int)(*((double *)(&ilh[4]) + i)));
565 for (j = 0; j < Block.nin; j++)
567 FREE(Block.inptr[j]);
575 if ((Block.outsz = (int *) MALLOC(Block.nout * 3 * sizeof(int))) == NULL)
577 Scierror(888, _("%s : Allocation error.\n"), fname);
578 for (j = 0; j < Block.nin; j++)
580 FREE(Block.inptr[j]);
587 if ((Block.outptr = (void **) MALLOC(Block.nout * sizeof(void *))) == NULL)
590 for (j = 0; j < Block.nin; j++)
592 FREE(Block.inptr[j]);
596 Scierror(888, _("%s : Allocation error.\n"), fname);
600 n = MlistGetFieldNumber(il1, "out2");
601 ilh2 = (int *) (listentry(il1, n));
604 /* check value of out2 */
605 for (i = 0; i < (mh2 * nh2); i++)
607 if ((*((double *)(&ilh2[4]) + i)) <= 0.)
609 Scierror(888, _("%s : Undetermined Size. out2(%d)=%d. Please adjust your model.\n"), \
610 fname, i + 1, (int)(*((double *)(&ilh2[4]) + i)));
611 for (j = 0; j < Block.nin; j++)
613 FREE(Block.inptr[j]);
622 /* 8 : model.outtyp */
623 n = MlistGetFieldNumber(il1, "outtyp");
624 ilh3 = (int *) (listentry(il1, n));
627 /* check value of intyp */
628 for (i = 0; i < (mh3 * nh3); i++)
630 if ((*((double *)(&ilh3[4]) + i)) <= 0.)
632 Scierror(888, _("%s : Undetermined Type. outtyp(%d)=%d. Please adjust your model.\n"), \
633 fname, i + 1, (int)(*((double *)(&ilh3[4]) + i)));
641 if (((mh * nh) == (mh2 * nh2)) && (((mh * nh) == (mh3 * nh3))))
643 for (i = 0; i < Block.nout; i++)
645 Block.outsz[i] = (int) * ((double *)(&ilh[4]) + i);
646 Block.outsz[Block.nout + i] = (int) * ((double *)(&ilh2[4]) + i);
647 type = *((double *)(&ilh3[4]) + i);
650 Block.outsz[2 * Block.nout + i] = 10;
654 Block.outsz[2 * Block.nout + i] = 11;
658 Block.outsz[2 * Block.nout + i] = 84;
662 Block.outsz[2 * Block.nout + i] = 82;
666 Block.outsz[2 * Block.nout + i] = 81;
670 Block.outsz[2 * Block.nout + i] = 814;
674 Block.outsz[2 * Block.nout + i] = 812;
678 Block.outsz[2 * Block.nout + i] = 811;
682 Block.outsz[2 * Block.nout + i] = 10;
688 for (i = 0; i < Block.nout; i++)
690 Block.outsz[i] = (int) * ((double *)(&ilh[4]) + i);
691 Block.outsz[Block.nout + i] = 1;
692 Block.outsz[2 * Block.nout + i] = 10;
695 for (i = 0; i < Block.nout; i++)
697 switch (Block.outsz[2 * Block.nout + i])
700 if ((Block.outptr[i] = (double *) \
701 MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(double))) == NULL)
703 for (j = 0; j < Block.nin; j++)
705 FREE(Block.inptr[j]);
709 for (j = 0; j < i; j++)
711 FREE(Block.outptr[j]);
715 Scierror(888, _("%s : Allocation error.\n"), fname);
718 ptr_d = (double *) Block.outptr[i];
719 for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
725 if ((Block.outptr[i] = (double *) \
726 MALLOC(2 * Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(double))) == NULL)
728 for (j = 0; j < Block.nin; j++)
730 FREE(Block.inptr[j]);
734 for (j = 0; j < i; j++)
736 FREE(Block.outptr[j]);
740 Scierror(888, _("%s : Allocation error.\n"), fname);
743 ptr_d = (double *) Block.outptr[i];
744 for (j = 0; j < 2 * Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
750 if ((Block.outptr[i] = (SCSINT32_COP *) \
751 MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(SCSINT32_COP))) == NULL)
753 for (j = 0; j < Block.nin; j++)
755 FREE(Block.inptr[j]);
759 for (j = 0; j < i; j++)
761 FREE(Block.outptr[j]);
765 Scierror(888, _("%s : Allocation error.\n"), fname);
768 ptr_l = (SCSINT32_COP *) Block.outptr[i];
769 for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
775 if ((Block.outptr[i] = (short *) \
776 MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(short))) == NULL)
778 for (j = 0; j < Block.nin; j++)
780 FREE(Block.inptr[j]);
784 for (j = 0; j < i; j++)
786 FREE(Block.outptr[j]);
790 Scierror(888, _("%s : Allocation error.\n"), fname);
793 ptr_s = (short *) Block.outptr[i];
794 for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
800 if ((Block.outptr[i] = (char *) \
801 MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(char))) == NULL)
803 for (j = 0; j < Block.nin; j++)
805 FREE(Block.inptr[j]);
809 for (j = 0; j < i; j++)
811 FREE(Block.outptr[j]);
815 Scierror(888, _("%s : Allocation error.\n"), fname);
818 ptr_c = (char *) Block.outptr[i];
819 for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
825 if ((Block.outptr[i] = (SCSUINT32_COP *) \
826 MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(SCSUINT32_COP))) == NULL)
828 for (j = 0; j < Block.nin; j++)
830 FREE(Block.inptr[j]);
834 for (j = 0; j < i; j++)
836 FREE(Block.outptr[j]);
840 Scierror(888, _("%s : Allocation error.\n"), fname);
843 ptr_ul = (SCSUINT32_COP *) Block.outptr[i];
844 for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
850 if ((Block.outptr[i] = (unsigned short *) \
851 MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(unsigned short))) == NULL)
853 for (j = 0; j < Block.nin; j++)
855 FREE(Block.inptr[j]);
859 for (j = 0; j < i; j++)
861 FREE(Block.outptr[j]);
865 Scierror(888, _("%s : Allocation error.\n"), fname);
868 ptr_us = (unsigned short *) Block.outptr[i];
869 for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
875 if ((Block.outptr[i] = (unsigned char *) \
876 MALLOC(Block.outsz[i] * Block.outsz[Block.nout + i] * sizeof(unsigned char))) == NULL)
878 for (j = 0; j < Block.nin; j++)
880 FREE(Block.inptr[j]);
884 for (j = 0; j < i; j++)
886 FREE(Block.outptr[j]);
890 Scierror(888, _("%s : Allocation error.\n"), fname);
893 ptr_uc = (unsigned char *) Block.outptr[i];
894 for (j = 0; j < Block.outsz[i]*Block.outsz[Block.nout + i]; j++)
903 /* event input port */
904 /* 9 : model.evtin */
906 /* event output port */
907 /* 10 : model.evtout */
908 n = MlistGetFieldNumber(il1, "evtout");
909 ilh = (int *) (listentry(il1, n));
912 Block.nevout = mh * nh;
916 if ((Block.evout = (double *) MALLOC(Block.nevout * sizeof(double))) == NULL)
918 for (j = 0; j < Block.nin; j++)
920 FREE(Block.inptr[j]);
924 for (j = 0; j < Block.nout; j++)
926 FREE(Block.outptr[j]);
930 Scierror(888, _("%s : Allocation error.\n"), fname);
933 n = MlistGetFieldNumber(il1, "firing");
934 ilh2 = (int *) (listentry(il1, n));
937 if ((mh * nh) == (mh2 * nh2))
939 for (j = 0; j < Block.nevout; j++)
941 Block.evout[j] = *((double *)(&ilh2[4]) + j);
946 for (j = 0; j < Block.nevout; j++)
948 Block.evout[j] = -1.0;
953 /* continuous state */
954 /* 11 : model.state */
955 n = MlistGetFieldNumber(il1, "state");
956 ilh = (int *) (listentry(il1, n));
967 if ((Block.x = (double *) MALLOC(Block.nx * sizeof(double))) == NULL)
969 for (j = 0; j < Block.nin; j++)
971 FREE(Block.inptr[j]);
975 for (j = 0; j < Block.nout; j++)
977 FREE(Block.outptr[j]);
982 Scierror(888, _("%s : Allocation error.\n"), fname);
986 for (j = 0; j < Block.nx; j++)
988 Block.x[j] = *((double *)(&ilh[4]) + j);
992 if ((Block.xd = (double *) MALLOC(Block.nx * sizeof(double))) == NULL)
994 for (j = 0; j < Block.nin; j++)
996 FREE(Block.inptr[j]);
1000 for (j = 0; j < Block.nout; j++)
1002 FREE(Block.outptr[j]);
1008 Scierror(888, _("%s : Allocation error.\n"), fname);
1012 for (j = 0; j < Block.nx; j++)
1017 if ((Block.xprop = (int *) MALLOC(Block.nx * sizeof(int))) == NULL)
1019 for (j = 0; j < Block.nin; j++)
1021 FREE(Block.inptr[j]);
1025 for (j = 0; j < Block.nout; j++)
1027 FREE(Block.outptr[j]);
1034 Scierror(888, _("%s : Allocation error.\n"), fname);
1038 for (j = 0; j < Block.nx; j++)
1043 /*if (blktyp>10000) {*/
1044 if ((Block.res = (double *) MALLOC(Block.nx * sizeof(double))) == NULL)
1046 for (j = 0; j < Block.nin; j++)
1048 FREE(Block.inptr[j]);
1052 for (j = 0; j < Block.nout; j++)
1054 FREE(Block.outptr[j]);
1062 Scierror(888, _("%s : Allocation error.\n"), fname);
1066 for (j = 0; j < Block.nx; j++)
1073 /* discrete state */
1074 /* 12 : model.dstate */
1075 n = MlistGetFieldNumber(il1, "dstate");
1076 ilh = (int *) (listentry(il1, n));
1084 if ((Block.z = (double *) MALLOC(Block.nz * sizeof(double))) == NULL)
1086 for (j = 0; j < Block.nin; j++)
1088 FREE(Block.inptr[j]);
1092 for (j = 0; j < Block.nout; j++)
1094 FREE(Block.outptr[j]);
1103 Scierror(888, _("%s : Allocation error.\n"), fname);
1107 for (j = 0; j < Block.nz; j++)
1109 Block.z[j] = *((double *)(&ilh[4]) + j);
1113 /* discrete object state */
1114 /* 13 : model.odstate */
1115 n = MlistGetFieldNumber(il1, "odstate");
1116 ilh = (int *) (listentry(il1, n));
1119 Block.noz = mh * nh;
1125 if ((Block.ozsz = (int *) MALLOC(2 * Block.noz * sizeof(int))) == NULL)
1127 for (j = 0; j < Block.nin; j++)
1129 FREE(Block.inptr[j]);
1133 for (j = 0; j < Block.nout; j++)
1135 FREE(Block.outptr[j]);
1145 Scierror(888, _("%s : Allocation error.\n"), fname);
1149 if ((Block.oztyp = (int *) MALLOC(Block.noz * sizeof(int))) == NULL)
1151 for (j = 0; j < Block.nin; j++)
1153 FREE(Block.inptr[j]);
1157 for (j = 0; j < Block.nout; j++)
1159 FREE(Block.outptr[j]);
1170 Scierror(888, _("%s : Allocation error.\n"), fname);
1174 if ((Block.ozptr = (void **) MALLOC(Block.noz * sizeof(void *))) == NULL)
1176 for (j = 0; j < Block.nin; j++)
1178 FREE(Block.inptr[j]);
1182 for (j = 0; j < Block.nout; j++)
1184 FREE(Block.outptr[j]);
1196 Scierror(888, _("%s : Allocation error.\n"), fname);
1200 for (i = 0; i < mh * nh; i++)
1202 ilh2 = (int *) (listentry(ilh, i + 1));
1205 Block.ozsz[i] = mh2;
1206 Block.ozsz[Block.noz + i] = nh2;
1211 Block.oztyp[i] = 10;
1212 if ((Block.ozptr[i] = (double *) MALLOC(mh2 * nh2 * sizeof(double))) == NULL)
1214 for (j = 0; j < Block.nin; j++)
1216 FREE(Block.inptr[j]);
1220 for (j = 0; j < Block.nout; j++)
1222 FREE(Block.outptr[j]);
1234 for (j = 0; j < i; j++)
1236 FREE(Block.ozptr[j]);
1238 Scierror(888, _("%s : Allocation error.\n"), fname);
1241 ptr_d = (double *) Block.ozptr[i];
1242 for (j = 0; j < mh2 * nh2; j++)
1244 ptr_d[j] = *((double *)(&ilh2[4]) + j);
1247 else if (ilh2[3] == 1)
1249 Block.oztyp[i] = 11;
1250 if ((Block.ozptr[i] = (double *) MALLOC(2 * mh2 * nh2 * sizeof(double))) == NULL)
1252 for (j = 0; j < Block.nin; j++)
1254 FREE(Block.inptr[j]);
1258 for (j = 0; j < Block.nout; j++)
1260 FREE(Block.outptr[j]);
1272 for (j = 0; j < i; j++)
1274 FREE(Block.ozptr[j]);
1276 Scierror(888, _("%s : Allocation error.\n"), fname);
1279 ptr_d = (double *) Block.ozptr[i];
1280 for (j = 0; j < 2 * mh2 * nh2; j++)
1282 ptr_d[j] = *((double *)(&ilh2[4]) + j);
1286 else if (ilh2[0] == 8)
1290 Block.oztyp[i] = 84;
1291 if ((Block.ozptr[i] = (SCSINT32_COP *) MALLOC(mh2 * nh2 * sizeof(SCSINT32_COP))) == NULL)
1293 for (j = 0; j < Block.nin; j++)
1295 FREE(Block.inptr[j]);
1299 for (j = 0; j < Block.nout; j++)
1301 FREE(Block.outptr[j]);
1313 for (j = 0; j < i; j++)
1315 FREE(Block.ozptr[j]);
1317 Scierror(888, _("%s : Allocation error.\n"), fname);
1320 ptr_l = (SCSINT32_COP *) Block.ozptr[i];
1321 for (j = 0; j < mh2 * nh2; j++)
1323 ptr_l[j] = *((SCSINT32_COP *)(&ilh2[4]) + j);
1326 else if (ilh2[3] == 2)
1328 Block.oztyp[i] = 82;
1329 if ((Block.ozptr[i] = (short *) MALLOC(mh2 * nh2 * sizeof(short))) == NULL)
1331 for (j = 0; j < Block.nin; j++)
1333 FREE(Block.inptr[j]);
1337 for (j = 0; j < Block.nout; j++)
1339 FREE(Block.outptr[j]);
1351 for (j = 0; j < i; j++)
1353 FREE(Block.ozptr[j]);
1355 Scierror(888, _("%s : Allocation error.\n"), fname);
1358 ptr_s = (short *) Block.ozptr[i];
1359 for (j = 0; j < mh2 * nh2; j++)
1361 ptr_s[j] = *((short *)(&ilh2[4]) + j);
1364 else if (ilh2[3] == 1)
1366 Block.oztyp[i] = 81;
1367 if ((Block.ozptr[i] = (char *) MALLOC(mh2 * nh2 * sizeof(char))) == NULL)
1369 for (j = 0; j < Block.nin; j++)
1371 FREE(Block.inptr[j]);
1375 for (j = 0; j < Block.nout; j++)
1377 FREE(Block.outptr[j]);
1389 for (j = 0; j < i; j++)
1391 FREE(Block.ozptr[j]);
1393 Scierror(888, _("%s : Allocation error.\n"), fname);
1396 ptr_c = (char *) Block.ozptr[i];
1397 for (j = 0; j < mh2 * nh2; j++)
1399 ptr_c[j] = *((char *)(&ilh2[4]) + j);
1402 else if (ilh2[3] == 14)
1404 Block.oztyp[i] = 814;
1405 if ((Block.ozptr[i] = (SCSUINT32_COP *) MALLOC(mh2 * nh2 * sizeof(SCSUINT32_COP))) == NULL)
1407 for (j = 0; j < Block.nin; j++)
1409 FREE(Block.inptr[j]);
1413 for (j = 0; j < Block.nout; j++)
1415 FREE(Block.outptr[j]);
1427 for (j = 0; j < i; j++)
1429 FREE(Block.ozptr[j]);
1431 Scierror(888, _("%s : Allocation error.\n"), fname);
1434 ptr_ul = (SCSUINT32_COP *) Block.ozptr[i];
1435 for (j = 0; j < mh2 * nh2; j++)
1437 ptr_ul[j] = *((SCSUINT32_COP *)(&ilh2[4]) + j);
1440 else if (ilh2[3] == 12)
1442 Block.oztyp[i] = 812;
1443 if ((Block.ozptr[i] = (unsigned short *) MALLOC(mh2 * nh2 * sizeof(unsigned short))) == NULL)
1445 for (j = 0; j < Block.nin; j++)
1447 FREE(Block.inptr[j]);
1451 for (j = 0; j < Block.nout; j++)
1453 FREE(Block.outptr[j]);
1465 for (j = 0; j < i; j++)
1467 FREE(Block.ozptr[j]);
1469 Scierror(888, _("%s : Allocation error.\n"), fname);
1472 ptr_us = (unsigned short *) Block.ozptr[i];
1473 for (j = 0; j < mh2 * nh2; j++)
1475 ptr_us[j] = *((unsigned short *)(&ilh2[4]) + j);
1478 else if (ilh2[3] == 11)
1480 Block.oztyp[i] = 811;
1481 if ((Block.ozptr[i] = (unsigned char *) MALLOC(mh2 * nh2 * sizeof(unsigned char))) == NULL)
1483 for (j = 0; j < Block.nin; j++)
1485 FREE(Block.inptr[j]);
1489 for (j = 0; j < Block.nout; j++)
1491 FREE(Block.outptr[j]);
1503 for (j = 0; j < i; j++)
1505 FREE(Block.ozptr[j]);
1507 Scierror(888, _("%s : Allocation error.\n"), fname);
1510 ptr_uc = (unsigned char *) Block.ozptr[i];
1511 for (j = 0; j < mh2 * nh2; j++)
1513 ptr_uc[j] = *((unsigned char *)(&ilh2[4]) + j);
1520 /* real parameters */
1521 /* 14 : model.rpar */
1522 n = MlistGetFieldNumber(il1, "rpar");
1523 ilh = (int *) (listentry(il1, n));
1526 Block.nrpar = mh * nh;
1530 if ((Block.rpar = (double *) MALLOC(Block.nrpar * sizeof(double))) == NULL)
1532 for (j = 0; j < Block.nin; j++)
1534 FREE(Block.inptr[j]);
1538 for (j = 0; j < Block.nout; j++)
1540 FREE(Block.outptr[j]);
1552 for (j = 0; j < Block.noz; j++)
1554 FREE(Block.ozptr[j]);
1556 Scierror(888, _("%s : Allocation error.\n"), fname);
1559 for (j = 0; j < Block.nrpar; j++)
1561 Block.rpar[j] = *((double *)(&ilh[4]) + j);
1565 /* integer parameters */
1566 /* 15 : model.ipar */
1567 n = MlistGetFieldNumber(il1, "ipar");
1568 ilh = (int *) (listentry(il1, n));
1571 Block.nipar = mh * nh;
1575 if ((Block.ipar = (int *) MALLOC(Block.nipar * sizeof(int))) == NULL)
1577 for (j = 0; j < Block.nin; j++)
1579 FREE(Block.inptr[j]);
1583 for (j = 0; j < Block.nout; j++)
1585 FREE(Block.outptr[j]);
1597 for (j = 0; j < Block.noz; j++)
1599 FREE(Block.ozptr[j]);
1602 Scierror(888, _("%s : Allocation error.\n"), fname);
1606 for (j = 0; j < Block.nipar; j++)
1608 Block.ipar[j] = (int) * ((double *)(&ilh[4]) + j);
1612 /* object parameters */
1613 /* 16 : model.opar */
1614 n = MlistGetFieldNumber(il1, "opar");
1615 ilh = (int *) (listentry(il1, n));
1618 Block.nopar = mh * nh;
1619 Block.oparsz = NULL;
1620 Block.opartyp = NULL;
1621 Block.oparptr = NULL;
1624 if ((Block.oparsz = (int *) MALLOC(2 * Block.nopar * sizeof(int))) == NULL)
1626 for (j = 0; j < Block.nin; j++)
1628 FREE(Block.inptr[j]);
1632 for (j = 0; j < Block.nout; j++)
1634 FREE(Block.outptr[j]);
1646 for (j = 0; j < Block.noz; j++)
1648 FREE(Block.ozptr[j]);
1652 Scierror(888, _("%s : Allocation error.\n"), fname);
1656 if ((Block.opartyp = (int *) MALLOC(Block.nopar * sizeof(int))) == NULL)
1658 for (j = 0; j < Block.nin; j++)
1660 FREE(Block.inptr[j]);
1664 for (j = 0; j < Block.nout; j++)
1666 FREE(Block.outptr[j]);
1678 for (j = 0; j < Block.noz; j++)
1680 FREE(Block.ozptr[j]);
1685 Scierror(888, _("%s : Allocation error.\n"), fname);
1689 if ((Block.oparptr = (void **) MALLOC(Block.nopar * sizeof(void *))) == NULL)
1691 for (j = 0; j < Block.nin; j++)
1693 FREE(Block.inptr[j]);
1697 for (j = 0; j < Block.nout; j++)
1699 FREE(Block.outptr[j]);
1711 for (j = 0; j < Block.noz; j++)
1713 FREE(Block.ozptr[j]);
1718 FREE(Block.opartyp);
1719 Scierror(888, _("%s : Allocation error.\n"), fname);
1723 for (i = 0; i < mh * nh; i++)
1725 ilh2 = (int *) (listentry(ilh, i + 1));
1728 Block.oparsz[i] = mh2;
1729 Block.oparsz[Block.nopar + i] = nh2;
1734 Block.opartyp[i] = 10;
1735 if ((Block.oparptr[i] = (double *) MALLOC(mh2 * nh2 * sizeof(double))) == NULL)
1737 for (j = 0; j < Block.nin; j++)
1739 FREE(Block.inptr[j]);
1743 for (j = 0; j < Block.nout; j++)
1745 FREE(Block.outptr[j]);
1757 for (j = 0; j < Block.noz; j++)
1759 FREE(Block.ozptr[j]);
1764 FREE(Block.opartyp);
1765 for (j = 0; j < i; j++)
1767 FREE(Block.oparptr[j]);
1769 Scierror(888, _("%s : Allocation error.\n"), fname);
1772 ptr_d = (double *) Block.oparptr[i];
1773 for (j = 0; j < mh2 * nh2; j++)
1775 ptr_d[j] = *((double *)(&ilh2[4]) + j);
1778 else if (ilh2[3] == 1)
1780 Block.opartyp[i] = 11;
1781 if ((Block.oparptr[i] = (double *) MALLOC(2 * mh2 * nh2 * sizeof(double))) == NULL)
1783 for (j = 0; j < Block.nin; j++)
1785 FREE(Block.inptr[j]);
1789 for (j = 0; j < Block.nout; j++)
1791 FREE(Block.outptr[j]);
1803 for (j = 0; j < Block.noz; j++)
1805 FREE(Block.ozptr[j]);
1810 FREE(Block.opartyp);
1811 for (j = 0; j < i; j++)
1813 FREE(Block.oparptr[j]);
1815 Scierror(888, _("%s : Allocation error.\n"), fname);
1819 ptr_d = (double *) Block.oparptr[i];
1820 for (j = 0; j < 2 * mh2 * nh2; j++)
1822 ptr_d[j] = *((double *)(&ilh2[4]) + j);
1826 else if (ilh2[0] == 8)
1830 Block.opartyp[i] = 84;
1831 if ((Block.oparptr[i] = (SCSINT32_COP *) MALLOC(mh2 * nh2 * sizeof(SCSINT32_COP))) == NULL)
1833 for (j = 0; j < Block.nin; j++)
1835 FREE(Block.inptr[j]);
1839 for (j = 0; j < Block.nout; j++)
1841 FREE(Block.outptr[j]);
1853 for (j = 0; j < Block.noz; j++)
1855 FREE(Block.ozptr[j]);
1860 FREE(Block.opartyp);
1861 for (j = 0; j < i; j++)
1863 FREE(Block.oparptr[j]);
1865 Scierror(888, _("%s : Allocation error.\n"), fname);
1868 ptr_l = (SCSINT32_COP *) Block.oparptr[i];
1869 for (j = 0; j < mh2 * nh2; j++)
1871 ptr_l[j] = *((SCSINT32_COP *)(&ilh2[4]) + j);
1874 else if (ilh2[3] == 2)
1876 Block.opartyp[i] = 82;
1877 if ((Block.oparptr[i] = (short *) MALLOC(mh2 * nh2 * sizeof(short))) == NULL)
1879 for (j = 0; j < Block.nin; j++)
1881 FREE(Block.inptr[j]);
1885 for (j = 0; j < Block.nout; j++)
1887 FREE(Block.outptr[j]);
1899 for (j = 0; j < Block.noz; j++)
1901 FREE(Block.ozptr[j]);
1906 FREE(Block.opartyp);
1907 for (j = 0; j < i; j++)
1909 FREE(Block.oparptr[j]);
1911 Scierror(888, _("%s : Allocation error.\n"), fname);
1914 ptr_s = (short *) Block.oparptr[i];
1915 for (j = 0; j < mh2 * nh2; j++)
1917 ptr_s[j] = *((short *)(&ilh2[4]) + j);
1920 else if (ilh2[3] == 1)
1922 Block.opartyp[i] = 81;
1923 if ((Block.oparptr[i] = (char *) MALLOC(mh2 * nh2 * sizeof(char))) == NULL)
1925 for (j = 0; j < Block.nin; j++)
1927 FREE(Block.inptr[j]);
1931 for (j = 0; j < Block.nout; j++)
1933 FREE(Block.outptr[j]);
1945 for (j = 0; j < Block.noz; j++)
1947 FREE(Block.ozptr[j]);
1952 FREE(Block.opartyp);
1953 for (j = 0; j < i; j++)
1955 FREE(Block.oparptr[j]);
1957 Scierror(888, _("%s : Allocation error.\n"), fname);
1960 ptr_c = (char *) Block.oparptr[i];
1961 for (j = 0; j < mh2 * nh2; j++)
1963 ptr_c[j] = *((char *)(&ilh2[4]) + j);
1966 else if (ilh2[3] == 14)
1968 Block.opartyp[i] = 814;
1969 if ((Block.oparptr[i] = (SCSUINT32_COP *) MALLOC(mh2 * nh2 * sizeof(SCSUINT32_COP))) == NULL)
1971 for (j = 0; j < Block.nin; j++)
1973 FREE(Block.inptr[j]);
1977 for (j = 0; j < Block.nout; j++)
1979 FREE(Block.outptr[j]);
1991 for (j = 0; j < Block.noz; j++)
1993 FREE(Block.ozptr[j]);
1998 FREE(Block.opartyp);
1999 for (j = 0; j < i; j++)
2001 FREE(Block.oparptr[j]);
2003 Scierror(888, _("%s : Allocation error.\n"), fname);
2006 ptr_ul = (SCSUINT32_COP *) Block.oparptr[i];
2007 for (j = 0; j < mh2 * nh2; j++)
2009 ptr_ul[j] = *((SCSUINT32_COP *)(&ilh2[4]) + j);
2012 else if (ilh2[3] == 12)
2014 Block.opartyp[i] = 812;
2015 if ((Block.oparptr[i] = (unsigned short *) MALLOC(mh2 * nh2 * sizeof(unsigned short))) == NULL)
2017 for (j = 0; j < Block.nin; j++)
2019 FREE(Block.inptr[j]);
2023 for (j = 0; j < Block.nout; j++)
2025 FREE(Block.outptr[j]);
2037 for (j = 0; j < Block.noz; j++)
2039 FREE(Block.ozptr[j]);
2044 FREE(Block.opartyp);
2045 for (j = 0; j < i; j++)
2047 FREE(Block.oparptr[j]);
2049 Scierror(888, _("%s : Allocation error.\n"), fname);
2052 ptr_us = (unsigned short *) Block.oparptr[i];
2053 for (j = 0; j < mh2 * nh2; j++)
2055 ptr_us[j] = *((unsigned short *)(&ilh2[4]) + j);
2058 else if (ilh2[3] == 11)
2060 Block.opartyp[i] = 811;
2061 if ((Block.oparptr[i] = (unsigned char *) MALLOC(mh2 * nh2 * sizeof(unsigned char))) == NULL)
2063 for (j = 0; j < Block.nin; j++)
2065 FREE(Block.inptr[j]);
2069 for (j = 0; j < Block.nout; j++)
2071 FREE(Block.outptr[j]);
2083 for (j = 0; j < Block.noz; j++)
2085 FREE(Block.ozptr[j]);
2090 FREE(Block.opartyp);
2091 for (j = 0; j < i; j++)
2093 FREE(Block.oparptr[j]);
2095 Scierror(888, _("%s : Allocation error.\n"), fname);
2098 ptr_uc = (unsigned char *) Block.oparptr[i];
2099 for (j = 0; j < mh2 * nh2; j++)
2101 ptr_uc[j] = *((unsigned char *)(&ilh2[4]) + j);
2109 /* 20 : model.label */
2110 n = MlistGetFieldNumber(il1, "label");
2111 ilh = (int *) (listentry(il1, n));
2117 len_str = ilh[5] - 1;
2120 if ((Block.label = (char *) MALLOC((len_str + 1) * sizeof(char))) == NULL)
2122 for (j = 0; j < Block.nin; j++)
2124 FREE(Block.inptr[j]);
2128 for (j = 0; j < Block.nout; j++)
2130 FREE(Block.outptr[j]);
2142 for (j = 0; j < Block.noz; j++)
2144 FREE(Block.ozptr[j]);
2149 FREE(Block.opartyp);
2150 for (j = 0; j < Block.nopar; j++)
2152 FREE(Block.oparptr[j]);
2154 Scierror(888, _("%s : Allocation error.\n"), fname);
2157 Block.label[len_str] = '\0';
2158 C2F(cvstr)(&len_str, &ilh[6], Block.label, (j = 1, &j), len_str);
2163 /* 21 : model.nzcross */
2164 n = MlistGetFieldNumber(il1, "nzcross");
2165 ilh = (int *) (listentry(il1, n));
2168 Block.ng = (int) * ((double *)(&ilh[4]));
2173 if ((Block.g = (double *) MALLOC(Block.ng * sizeof(double))) == NULL)
2175 for (j = 0; j < Block.nin; j++)
2177 FREE(Block.inptr[j]);
2181 for (j = 0; j < Block.nout; j++)
2183 FREE(Block.outptr[j]);
2195 for (j = 0; j < Block.noz; j++)
2197 FREE(Block.ozptr[j]);
2202 FREE(Block.opartyp);
2203 for (j = 0; j < Block.nopar; j++)
2205 FREE(Block.oparptr[j]);
2208 Scierror(888, _("%s : Allocation error.\n"), fname);
2212 for (j = 0; j < Block.ng; j++)
2216 if ((Block.jroot = (int *) MALLOC(Block.ng * sizeof(int))) == NULL)
2218 for (j = 0; j < Block.nin; j++)
2220 FREE(Block.inptr[j]);
2224 for (j = 0; j < Block.nout; j++)
2226 FREE(Block.outptr[j]);
2238 for (j = 0; j < Block.noz; j++)
2240 FREE(Block.ozptr[j]);
2245 FREE(Block.opartyp);
2246 for (j = 0; j < Block.nopar; j++)
2248 FREE(Block.oparptr[j]);
2252 Scierror(888, _("%s : Allocation error.\n"), fname);
2256 for (j = 0; j < Block.ng; j++)
2263 /* 22 : model.nmode */
2264 n = MlistGetFieldNumber(il1, "nmode");
2265 ilh = (int *) (listentry(il1, n));
2268 Block.nmode = (int) * ((double *)(&ilh[4]));
2270 if (Block.nmode != 0)
2272 if ((Block.mode = (int *) MALLOC(Block.nmode * sizeof(double))) == NULL)
2274 for (j = 0; j < Block.nin; j++)
2276 FREE(Block.inptr[j]);
2280 for (j = 0; j < Block.nout; j++)
2282 FREE(Block.outptr[j]);
2294 for (j = 0; j < Block.noz; j++)
2296 FREE(Block.ozptr[j]);
2301 FREE(Block.opartyp);
2302 for (j = 0; j < Block.nopar; j++)
2304 FREE(Block.oparptr[j]);
2309 Scierror(888, _("%s : Allocation error.\n"), fname);
2313 for (j = 0; j < Block.nmode; j++)
2320 if ((Block.work = (void **) MALLOC(sizeof(void *))) == NULL)
2322 for (j = 0; j < Block.nin; j++)
2324 FREE(Block.inptr[j]);
2328 for (j = 0; j < Block.nout; j++)
2330 FREE(Block.outptr[j]);
2342 for (j = 0; j < Block.noz; j++)
2344 FREE(Block.ozptr[j]);
2349 FREE(Block.opartyp);
2350 for (j = 0; j < Block.nopar; j++)
2352 FREE(Block.oparptr[j]);
2358 Scierror(888, _("%s : Allocation error.\n"), fname);
2365 ierr = createblklist(&Block, &ierr, -1, Block.type);
2367 for (j = 0; j < Block.nin; j++)
2369 FREE(Block.inptr[j]);
2373 for (j = 0; j < Block.nout; j++)
2375 FREE(Block.outptr[j]);
2386 for (j = 0; j < Block.noz; j++)
2388 FREE(Block.ozptr[j]);
2393 FREE(Block.opartyp);
2394 for (j = 0; j < Block.nopar; j++)
2396 FREE(Block.oparptr[j]);
2407 CreateVar(2, TYPED_LIST_DATATYPE, &nblklst, (j = 1, &j), &l_tmp);
2413 /*--------------------------------------------------------------------------*/