scilab/modules/scicos/src/c/import.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 <string.h>
  23 #include <stdio.h>
  24 #include "machine.h"
  25 #include "import.h"
  26 #include "scicos.h"
  27 #include "scicos_internal.h"
  28 #include "cvstr.h"
  29 /*--------------------------------------------------------------------------*/
  30 ScicosImport scicos_imp =
  31 {
  32     (double *)  NULL,      /* x      **  */
  33     (int *) NULL,      /* nx         */
  34     (int *) NULL,      /* xptr   **  */
  35     (int *) NULL,      /* zcptr  **  */
  36     (double *)  NULL,      /* z      **  */
  37     (int *) NULL,      /* nz         */
  38     (int *) NULL,      /* zptr   **  */
  39     (int *) NULL,      /* noz        */
  40     (void **)   NULL,      /* oz         */
  41     (int *) NULL,      /* ozsz       */
  42     (int *) NULL,      /* oztyp      */
  43     (int *) NULL,      /* ozptr      */
  44     (double *)  NULL,      /* g          */
  45     (int *) NULL,      /* ng         */
  46     (int *) NULL,      /* mod        */
  47     (int *) NULL,      /* nmod       */
  48     (int *) NULL,      /* modptr **  */
  49     (int *) NULL,      /* iz         */
  50     (int *) NULL,      /* izptr      */
  51     (int *) NULL,      /* uid        */
  52     (int *) NULL,      /* uidptr     */
  53     (int *) NULL,      /* inpptr **  */
  54     (int *) NULL,      /* inplnk **  */
  55     (int *) NULL,      /* outptr **  */
  56     (int *) NULL,      /* outlnk **  */
  57     (double *)  NULL,      /* rpar   **  */
  58     (int *) NULL,      /* rpptr  **  */
  59     (int *) NULL,      /* ipar   **  */
  60     (int *) NULL,      /* ipptr  **  */
  61     (void **)   NULL,      /* opar       */
  62     (int *) NULL,      /* oparsz     */
  63     (int *) NULL,      /* opartyp    */
  64     (int *) NULL,      /* opptr      */
  65     (int *) NULL,      /* nblk       */
  66     (void **)   NULL,      /* outtbptr   */
  67     (int *) NULL,      /* outtbsz    */
  68     (int *) NULL,      /* outtbtyp   */
  69     (int *) NULL,      /* nlnk       */
  70     (int *) NULL,      /* subs   **  */
  71     (int *) NULL,      /* nsubs      */
  72     (double *)  NULL,      /* tevts  **  */
  73     (int *) NULL,      /* evtspt **  */
  74     (int *) NULL,      /* nevts      */
  75     (int *) NULL,      /* pointi **  */
  76     (int *) NULL,      /* iord   **  */
  77     (int *) NULL,      /* niord      */
  78     (int *) NULL,      /* oord   **  */
  79     (int *) NULL,      /* noord      */
  80     (int *) NULL,      /* zord   **  */
  81     (int *) NULL,      /* nzord      */
  82     (int *) NULL,      /* funptr     */
  83     (int *) NULL,      /* funtyp **  */
  84     (int *) NULL,      /* ztyp   **  */
  85     (int *) NULL,      /* cord   **  */
  86     (int *) NULL,      /* ncord      */
  87     (int *) NULL,      /* ordclk **  */
  88     (int *) NULL,      /* nordclk ** */
  89     (int *) NULL,      /* clkptr **  */
  90     (int *) NULL,      /* ordptr **  */
  91     (int *) NULL,      /* nordptr    */
  92     (int *) NULL,      /* critev **  */
  93     (int *) NULL,      /* iwa        */
  94     (int *) NULL,      /* mask       */
  95     (scicos_block *) NULL, /* blocks     */
  96     (double *)  NULL,      /* t0         */
  97     (double *)  NULL,      /* tf         */
  98     (double *)  NULL,      /* Atol       */
  99     (double *)  NULL,      /* rtol       */
 100     (double *)  NULL,      /* ttol       */
 101     (double *)  NULL,      /* deltat     */
 102     (double *)  NULL,      /* hmax       */
 103     (outtb_el *) NULL,     /* outtb_elem */
 104     (int *) NULL,      /* nelem      */
 105     (int *) NULL,      /* xprop      */
 106     (double *)  NULL,      /* xd         */
 107 };
 108
 109 /*--------------------------------------------------------------------------*/
 110 /* getscicosimportptr returns a pointer
 111  * to the imported structure
 112  */
 113 ScicosImport* getscicosimportptr(void)
 114 {
 115     return &scicos_imp;
 116 }
 117 /*--------------------------------------------------------------------------*/
 118 void makescicosimport(double *x, int *nx,
 119                       int *xptr, int *zcptr,
 120                       double *z, int *nz, int *zptr,
 121                       int *noz, void **oz, int *ozsz, int *oztyp, int *ozptr,
 122                       double *g, int *ng,
 123                       int *mod, int *nmod, int *modptr,
 124                       int *iz, int *izptr, int *uid, int *uidptr, int *inpptr, int *inplnk,
 125                       int *outptr, int *outlnk, void **outtbptr, int *outtbsz, int *outtbtyp,
 126                       outtb_el *outtb_elem, int *nelem,
 127                       int *nlnk, double *rpar, int *rpptr, int *ipar, int *ipptr,
 128                       void **opar, int *oparsz, int *opartyp, int *opptr,
 129                       int *nblk, int *subs, int *nsubs,
 130                       double *tevts, int *evtspt, int *nevts, int *pointi,
 131                       int *iord, int *niord, int *oord, int *noord, int *zord, int *nzord,
 132                       int *funptr, int *funtyp, int *ztyp,
 133                       int *cord, int *ncord, int *ordclk, int *nordclk, int *clkptr,
 134                       int *ordptr, int *nordptr, int *critev,  int *iwa, scicos_block *blocks,
 135                       double *t0, double *tf, double *Atol, double *rtol, double *ttol, double *deltat, double *hmax,
 136                       int *xprop, double *xd)
 137 {
 138     scicos_imp.x = x;
 139     scicos_imp.nx = nx;
 140     scicos_imp.xptr = xptr;
 141     scicos_imp.zcptr = zcptr;
 142     scicos_imp.z = z;
 143     scicos_imp.nz = nz;
 144     scicos_imp.zptr = zptr;
 145
 146     scicos_imp.noz = noz;
 147     scicos_imp.oz = oz;
 148     scicos_imp.ozsz = ozsz;
 149     scicos_imp.oztyp = oztyp;
 150     scicos_imp.ozptr = ozptr;
 151
 152     scicos_imp.g = g;
 153     scicos_imp.ng = ng;
 154     scicos_imp.mod = mod;
 155     scicos_imp.nmod = nmod;
 156     scicos_imp.modptr = modptr;
 157     scicos_imp.iz = iz;
 158     scicos_imp.izptr = izptr;
 159     scicos_imp.uid = uid;
 160     scicos_imp.uidptr = uidptr;
 161
 162     scicos_imp.inpptr = inpptr;
 163     scicos_imp.inplnk = inplnk;
 164     scicos_imp.outptr = outptr;
 165     scicos_imp.outlnk = outlnk;
 166
 167     scicos_imp.rpar = rpar;
 168     scicos_imp.rpptr = rpptr;
 169     scicos_imp.ipar = ipar;
 170     scicos_imp.ipptr = ipptr;
 171
 172     scicos_imp.opar = opar;
 173     scicos_imp.oparsz = oparsz;
 174     scicos_imp.opartyp = opartyp;
 175     scicos_imp.opptr = opptr;
 176
 177     scicos_imp.nblk = nblk;
 178     scicos_imp.outtbptr = outtbptr;
 179     scicos_imp.outtbsz = outtbsz;
 180     scicos_imp.outtbtyp = outtbtyp;
 181     scicos_imp.outtb_elem = outtb_elem;
 182     scicos_imp.nelem = nelem;
 183     scicos_imp.nlnk = nlnk;
 184
 185     scicos_imp.subs = subs;
 186     scicos_imp.nsubs = nsubs;
 187
 188     scicos_imp.tevts = tevts;
 189     scicos_imp.evtspt = evtspt;
 190     scicos_imp.nevts = nevts;
 191     scicos_imp.pointi = pointi;
 192
 193     scicos_imp.iord = iord;
 194     scicos_imp.niord = niord;
 195     scicos_imp.oord = oord;
 196     scicos_imp.noord = noord;
 197     scicos_imp.zord = zord;
 198     scicos_imp.nzord = nzord;
 199
 200     scicos_imp.funptr = funptr;
 201     scicos_imp.funtyp = funtyp;
 202
 203     scicos_imp.ztyp = ztyp;
 204     scicos_imp.cord = cord;
 205     scicos_imp.ncord = ncord;
 206     scicos_imp.ordclk = ordclk;
 207     scicos_imp.nordclk = nordclk;
 208     scicos_imp.clkptr = clkptr;
 209     scicos_imp.ordptr = ordptr;
 210     scicos_imp.nordptr = nordptr;
 211     scicos_imp.critev = critev;
 212     scicos_imp.iwa = iwa;
 213     scicos_imp.blocks = blocks;
 214
 215     scicos_imp.t0 = t0;
 216     scicos_imp.tf = tf;
 217     scicos_imp.Atol = Atol;
 218     scicos_imp.ttol = ttol;
 219     scicos_imp.rtol = rtol;
 220     scicos_imp.deltat = deltat;
 221     scicos_imp.hmax = hmax;
 222
 223     scicos_imp.xprop = xprop;
 224     scicos_imp.xd = xd;
 225 }
 226 /*--------------------------------------------------------------------------*/
 227 void C2F(clearscicosimport)()
 228 {
 229     scicos_imp.x = (double *) NULL;
 230     scicos_imp.nx = (int *) NULL;
 231     scicos_imp.xptr = (int *) NULL;
 232     scicos_imp.zcptr = (int *) NULL;
 233     scicos_imp.z = (double *) NULL;
 234     scicos_imp.nz = (int *) NULL;
 235     scicos_imp.zptr = (int *) NULL;
 236
 237     scicos_imp.noz = (int *) NULL;
 238     scicos_imp.oz = (void **) NULL;
 239     scicos_imp.ozsz = (int *) NULL;
 240     scicos_imp.oztyp = (int *) NULL;
 241     scicos_imp.ozptr = (int *) NULL;
 242
 243     scicos_imp.g = (double *) NULL;
 244     scicos_imp.ng = (int *) NULL;
 245     scicos_imp.mod = (int *) NULL;
 246     scicos_imp.nmod = (int *) NULL;
 247     scicos_imp.modptr = (int *) NULL;
 248     scicos_imp.iz = (int *) NULL;
 249     scicos_imp.izptr = (int *) NULL;
 250     scicos_imp.uid = (int *) NULL;
 251     scicos_imp.uidptr = (int *) NULL;
 252
 253     scicos_imp.inpptr = (int *) NULL;
 254     scicos_imp.inplnk = (int *) NULL;
 255     scicos_imp.outptr = (int *) NULL;
 256     scicos_imp.outlnk = (int *) NULL;
 257
 258     scicos_imp.rpar = (double *) NULL;
 259     scicos_imp.rpptr = (int *) NULL;
 260     scicos_imp.ipar = (int *) NULL;
 261     scicos_imp.ipptr = (int *) NULL;
 262
 263     scicos_imp.opar = (void **) NULL;
 264     scicos_imp.oparsz = (int *) NULL;
 265     scicos_imp.opartyp = (int *) NULL;
 266     scicos_imp.opptr = (int *) NULL;
 267
 268     scicos_imp.nblk = (int *) NULL;
 269     scicos_imp.outtbptr = (void **) NULL;
 270     scicos_imp.outtbsz = (int *) NULL;
 271     scicos_imp.outtbtyp = (int *) NULL;
 272     scicos_imp.outtb_elem = (outtb_el *) NULL;
 273     scicos_imp.nelem = (int *) NULL;
 274     scicos_imp.nlnk = (int *) NULL;
 275
 276     scicos_imp.subs = (int *) NULL;
 277     scicos_imp.nsubs = (int *) NULL;
 278     scicos_imp.tevts = (double *) NULL;
 279     scicos_imp.evtspt = (int *) NULL;
 280     scicos_imp.nevts = (int *) NULL;
 281     scicos_imp.pointi = (int *) NULL;
 282
 283     scicos_imp.iord = (int *) NULL;
 284     scicos_imp.niord = (int *) NULL;
 285     scicos_imp.oord = (int *) NULL;
 286     scicos_imp.noord = (int *) NULL;
 287     scicos_imp.zord = (int *) NULL;
 288     scicos_imp.nzord = (int *) NULL;
 289
 290     scicos_imp.funptr = (int *) NULL;
 291     scicos_imp.funtyp = (int *) NULL;
 292
 293     scicos_imp.ztyp = (int *) NULL;
 294     scicos_imp.cord = (int *) NULL;
 295     scicos_imp.ncord = (int *) NULL;
 296     scicos_imp.ordclk = (int *) NULL;
 297     scicos_imp.nordclk = (int *) NULL;
 298     scicos_imp.clkptr = (int *) NULL;
 299     scicos_imp.ordptr = (int *) NULL;
 300     scicos_imp.nordptr = (int *) NULL;
 301     scicos_imp.critev = (int *) NULL;
 302
 303     scicos_imp.iwa = (int *) NULL;
 304     scicos_imp.mask = (int *) NULL;
 305     scicos_imp.blocks = (scicos_block *) NULL;
 306
 307     scicos_imp.t0 = (double *) NULL;
 308     scicos_imp.tf = (double *) NULL;
 309     scicos_imp.Atol = (double *) NULL;
 310     scicos_imp.ttol = (double *) NULL;
 311     scicos_imp.rtol = (double *) NULL;
 312     scicos_imp.deltat = (double *) NULL;
 313     scicos_imp.hmax = (double *) NULL;
 314
 315     scicos_imp.xprop = (int *) NULL;
 316     scicos_imp.xd = (double *) NULL;
 317 }
 318 /*--------------------------------------------------------------------------*/
 319 /* 20/06/06, Alan : review
 320  * 08/02/07, Alan : update
 321  */
 322
 323 int getscicosvarsfromimport(char *what, void **v, int *nv, int *mv)
 324 /*char *what;   data structure selection -see import.h for definition-*/
 325 /*void **v;     Pointer to the beginning of the imported data */
 326 /*int *nv;      size 1 of the imported data */
 327 /*int *mv; size 1 of the imported data */
 328 {
 329     /*variable declaration*/
 330     int nx, nz, noz, nmod, nblk, nlnk, nsubs, nevts, ng;
 331     int niord, noord, ncord, nordptr, nzord, nelem;
 332
 333     /*test if scicosim is running*/
 334     if (scicos_imp.x == (double *)NULL)
 335     {
 336         v = (void *) NULL;
 337         return 0; /* undefined import table scicos is not running */
 338     }
 339
 340     /* retrieve length of x register */
 341     nx = (int) scicos_imp.nx[0];
 342     /* retrieve length of z register */
 343     nz = (int) scicos_imp.nz[0];
 344     /* retrieve length of oz register */
 345     noz = (int) scicos_imp.noz[0];
 346     /* retrieve number of block */
 347     nmod = (int) scicos_imp.nmod[0];
 348     /* retrieve number of block */
 349     nblk = (int) scicos_imp.nblk[0];
 350     /* retrieve number of link */
 351     nlnk = (int) scicos_imp.nlnk[0];
 352     /* retrieve number nsubs */
 353     nsubs = (int) scicos_imp.nsubs[0];
 354     /* retrieve number nevts */
 355     nevts = (int) scicos_imp.nevts[0];
 356     /* retrieve number niord */
 357     niord = (int) scicos_imp.niord[0];
 358     /* retrieve number noord */
 359     noord = (int) scicos_imp.noord[0];
 360     /* retrieve number ncord */
 361     ncord = (int) scicos_imp.ncord[0];
 362     /* retrieve number nordptr */
 363     nordptr = (int) scicos_imp.nordptr[0];
 364     /* retrieve number nzord */
 365     nzord = (int) scicos_imp.nzord[0];
 366     /* retrieve number ng */
 367     ng = (int) scicos_imp.ng[0];
 368     /* retrieve number nelem */
 369     nelem = (int) scicos_imp.nelem[0];
 370
 371     /* imported from */
 372     if (strcmp(what, "x") == 0)
 373     {
 374         /* x - continuous state */
 375         *nv = (int) (scicos_imp.xptr[nblk] - scicos_imp.xptr[0]);
 376         *mv = 1;
 377         *v  = (double *)(scicos_imp.x);
 378     }
 379     else if (strcmp(what, "nx") == 0)
 380     {
 381         /* length of x register */
 382         *nv = 1;
 383         *mv = 1;
 384         *v  = (int *) (scicos_imp.nx);
 385     }
 386     else if (strcmp(what, "xptr") == 0)
 387     {
 388         /* xptr - continuous state splitting array */
 389         *nv = nblk + 1;
 390         *mv = 1;
 391         *v  = (int *) (scicos_imp.xptr);
 392     }
 393     else if (strcmp(what, "zcptr") == 0)
 394     {
 395         /* zcptr - zero crossing splitting array */
 396         *nv = nblk + 1;
 397         *mv = 1;
 398         *v  = (int *) (scicos_imp.zcptr);
 399     }
 400     else if (strcmp(what, "z") == 0)
 401     {
 402         /* z - discrete state */
 403         *nv = (int)(scicos_imp.zptr[nblk] - scicos_imp.zptr[0]);
 404         *mv = 1;
 405         *v  = (double *) (scicos_imp.z);
 406     }
 407     else if (strcmp(what, "nz") == 0)
 408     {
 409         /* length of z register */
 410         *nv = 1;
 411         *mv = 1;
 412         *v  = (int *) (scicos_imp.nz);
 413     }
 414     else if (strcmp(what, "noz") == 0)
 415     {
 416         /* length of oz register */
 417         *nv = 1;
 418         *mv = 1;
 419         *v  = (int *) (scicos_imp.noz);
 420     }
 421     else if (strcmp(what, "oz") == 0)
 422     {
 423         /* oz - vector of ptr of object discrete states */
 424         *nv = (int)(scicos_imp.ozptr[nblk] - scicos_imp.ozptr[0]);
 425         *mv = 1;
 426         *v  = (int *) (scicos_imp.oz);
 427     }
 428     else if (strcmp(what, "ozptr") == 0)
 429     {
 430         /* ozptr - object discrete states splitting array */
 431         *nv = nblk + 1;
 432         *mv = 1;
 433         *v  = (int *) (scicos_imp.ozptr);
 434     }
 435     else if (strcmp(what, "ozsz") == 0)
 436     {
 437         /* oparsz - object discrete states size array */
 438         *nv = (int)(scicos_imp.ozptr[nblk] - scicos_imp.ozptr[0]);
 439         *mv = 2;
 440         *v  = (int *) (scicos_imp.ozsz);
 441     }
 442     else if (strcmp(what, "oztyp") == 0)
 443     {
 444         /* opartyp - object discrete states type array */
 445         *nv = (int)(scicos_imp.ozptr[nblk] - scicos_imp.ozptr[0]);
 446         *mv = 1;
 447         *v  = (int *) (scicos_imp.oztyp);
 448     }
 449     else if (strcmp(what, "zptr") == 0)
 450     {
 451         /* zptr - discrete state splitting array */
 452         *nv = nblk + 1;
 453         *mv = 1;
 454         *v  = (int *) (scicos_imp.zptr);
 455     }
 456     else if (strcmp(what, "mod") == 0)
 457     {
 458         /* modes - block discontinuities array */
 459         *nv = (int)(scicos_imp.modptr[nblk] - scicos_imp.modptr[0]);
 460         *mv = 1;
 461         *v  = (int *) (scicos_imp.mod);
 462     }
 463     else if (strcmp(what, "nmod") == 0)
 464     {
 465         /* nmodes - number of block discontinuities array */
 466         *nv = 1;
 467         *mv = 1;
 468         *v  = (int *) (scicos_imp.nmod);
 469     }
 470     else if (strcmp(what, "modptr") == 0)
 471     {
 472         /* modptr - block discontinuities splitting array */
 473         *nv = nblk + 1;
 474         *mv = 1;
 475         *v  = (int *) (scicos_imp.modptr);
 476     }
 477     else if (strcmp(what, "iz") == 0)
 478     {
 479         /* iz - label integer code of blocks array */
 480         *nv = (int)(scicos_imp.izptr[nblk] - scicos_imp.izptr[0]);
 481         *mv = 1;
 482         *v  = (int *) (scicos_imp.iz);
 483     }
 484     else if (strcmp(what, "izptr") == 0)
 485     {
 486         /* izptr - label integer code of blocks splitting array */
 487         *nv = nblk + 1;
 488         *mv = 1;
 489         *v  = (int *) (scicos_imp.izptr);
 490     }
 491     else if (strcmp(what, "uid") == 0)
 492     {
 493         /* uid */
 494         *nv = (int)(scicos_imp.uidptr[nblk] - scicos_imp.uidptr[0]);
 495         *mv = 1;
 496         *v  = (int *) (scicos_imp.uid);
 497     }
 498     else if (strcmp(what, "uidptr") == 0)
 499     {
 500         /* uidptr */
 501         *nv = nblk + 1;
 502         *mv = 1;
 503         *v  = (int *) (scicos_imp.uidptr);
 504     }
 505     else if (strcmp(what, "inpptr") == 0)
 506     {
 507         /* inpptr */
 508         *nv = nblk + 1;
 509         *mv = 1;
 510         *v  = (int *) (scicos_imp.inpptr);
 511     }
 512     else if (strcmp(what, "inplnk") == 0)
 513     {
 514         /* inplnk */
 515         *nv = (int)(scicos_imp.inpptr[nblk] - scicos_imp.inpptr[0]);
 516         *mv = 1;
 517         *v  = (int *) (scicos_imp.inplnk);
 518     }
 519     else if (strcmp(what, "outptr") == 0)
 520     {
 521         /* outptr */
 522         *nv = nblk + 1;
 523         *mv = 1;
 524         *v  = (int *) (scicos_imp.outptr);
 525     }
 526     else if (strcmp(what, "outlnk") == 0)
 527     {
 528         /* outlnk */
 529         *nv = (int)(scicos_imp.outptr[nblk] - scicos_imp.outptr[0]);
 530         *mv = 1;
 531         *v  = (int *) (scicos_imp.outlnk);
 532     }
 533     else if (strcmp(what, "rpar") == 0)
 534     {
 535         /* rpar - vector of real parameters */
 536         *nv = (int)(scicos_imp.rpptr[nblk] - scicos_imp.rpptr[0]);
 537         *mv = 1;
 538         *v  = (double *) (scicos_imp.rpar);
 539     }
 540     else if (strcmp(what, "rpptr") == 0)
 541     {
 542         /* rpptr - real parameters splitting array */
 543         *nv = nblk + 1;
 544         *mv = 1;
 545         *v  = (int *) (scicos_imp.rpptr);
 546     }
 547     else if (strcmp(what, "ipar") == 0)
 548     {
 549         /* ipar - vector of integer parameters */
 550         *nv = (int)(scicos_imp.ipptr[nblk] - scicos_imp.ipptr[0]);
 551         *mv = 1;
 552         *v  = (int *) (scicos_imp.ipar);
 553     }
 554     else if (strcmp(what, "ipptr") == 0)
 555     {
 556         /* ipptr - integer parameters splitting array */
 557         *nv = nblk + 1;
 558         *mv = 1;
 559         *v  = (int *) (scicos_imp.ipptr);
 560     }
 561     else if (strcmp(what, "opar") == 0)
 562     {
 563         /* opar - vector of ptr of objects parameters */
 564         *nv = (int)(scicos_imp.opptr[nblk] - scicos_imp.opptr[0]);
 565         *mv = 1;
 566         *v  = (int *) (scicos_imp.opar);
 567     }
 568     else if (strcmp(what, "opptr") == 0)
 569     {
 570         /* opptr - object parameters splitting array */
 571         *nv = nblk + 1;
 572         *mv = 1;
 573         *v  = (int *) (scicos_imp.opptr);
 574     }
 575     else if (strcmp(what, "oparsz") == 0)
 576     {
 577         /* oparsz - object parameters size array */
 578         *nv = (int)(scicos_imp.opptr[nblk] - scicos_imp.opptr[0]);
 579         *mv = 2;
 580         *v  = (int *) (scicos_imp.oparsz);
 581     }
 582     else if (strcmp(what, "opartyp") == 0)
 583     {
 584         /* opartyp - object parameters type array */
 585         *nv = (int)(scicos_imp.opptr[nblk] - scicos_imp.opptr[0]);
 586         *mv = 1;
 587         *v  = (int *) (scicos_imp.opartyp);
 588     }
 589     else if (strcmp(what, "nblk") == 0)
 590     {
 591         /* number of block */
 592         *nv = 1;
 593         *mv = 1;
 594         *v  = (int *) (scicos_imp.nblk);
 595     }
 596     else if (strcmp(what, "outtbptr") == 0)
 597     {
 598         /* ptr on output register */
 599         *nv = nlnk;
 600         *mv = 1;
 601         *v  = (int *) (scicos_imp.outtbptr);
 602     }
 603     else if (strcmp(what, "outtbsz") == 0)
 604     {
 605         /* size of output register */
 606         *nv = nlnk;
 607         *mv = 2;
 608         *v  = (int *) (scicos_imp.outtbsz);
 609     }
 610     else if (strcmp(what, "outtbtyp") == 0)
 611     {
 612         /* type of output register  */
 613         *nv = nlnk;
 614         *mv = 1;
 615         *v  = (int *) (scicos_imp.outtbtyp);
 616     }
 617     else if (strcmp(what, "nlnk") == 0)
 618     {
 619         /* number of link  */
 620         *nv = 1;
 621         *mv = 1;
 622         *v  = (int *) (scicos_imp.nlnk);
 623     }
 624     else if (strcmp(what, "subs") == 0) /* Aquoisertsubs?? */
 625     {
 626         /*   */
 627         *nv = nsubs;
 628         *mv = 1;
 629         *v  = (int *) (scicos_imp.subs);
 630     }
 631     else if (strcmp(what, "nsubs") == 0)
 632     {
 633         /*   */
 634         *nv = 1;
 635         *mv = 1;
 636         *v  = (int *) (scicos_imp.nsubs);
 637     }
 638     else if (strcmp(what, "tevts") == 0)
 639     {
 640         /*   */
 641         *nv = nevts;
 642         *mv = 1;
 643         *v  = (double *) (scicos_imp.tevts);
 644     }
 645     else if (strcmp(what, "evtspt") == 0)
 646     {
 647         /*   */
 648         *nv = nevts;
 649         *mv = 1;
 650         *v  = (int *) (scicos_imp.evtspt);
 651     }
 652     else if (strcmp(what, "nevts") == 0)
 653     {
 654         /*   */
 655         *nv = 1;
 656         *mv = 1;
 657         *v  = (int *) (scicos_imp.nevts);
 658     }
 659     else if (strcmp(what, "pointi") == 0)
 660     {
 661         /* */
 662         *nv = 1;
 663         *mv = 1;
 664         *v  = (int *) (scicos_imp.pointi);
 665     }
 666     else if (strcmp(what, "iord") == 0)
 667     {
 668         /* */
 669         *nv = niord;
 670         *mv = 2;
 671         *v  = (int *) (scicos_imp.iord);
 672     }
 673     else if (strcmp(what, "niord") == 0)
 674     {
 675         /* */
 676         *nv = 1;
 677         *mv = 1;
 678         *v  = (int *) (scicos_imp.niord);
 679     }
 680     else if (strcmp(what, "oord") == 0)
 681     {
 682         /* */
 683         *nv = noord;
 684         *mv = 2;
 685         *v  = (int *) (scicos_imp.oord);
 686     }
 687     else if (strcmp(what, "noord") == 0)
 688     {
 689         /* */
 690         *nv = 1;
 691         *mv = 1;
 692         *v  = (int *) (scicos_imp.noord);
 693     }
 694     else if (strcmp(what, "zord") == 0)
 695     {
 696         /* */
 697         *nv = nzord;
 698         *mv = 2;
 699         *v  = (int *) (scicos_imp.zord);
 700     }
 701     else if (strcmp(what, "nzord") == 0)
 702     {
 703         /* */
 704         *nv = 1;
 705         *mv = 1;
 706         *v  = (int *) (scicos_imp.nzord);
 707     }
 708     else if (strcmp(what, "funptr") == 0)
 709     {
 710         /* */
 711         *nv = nblk;
 712         *mv = 1;
 713         *v  = (int *) (scicos_imp.funptr);
 714     }
 715     else if (strcmp(what, "funtyp") == 0)
 716     {
 717         /* */
 718         *nv = nblk;
 719         *mv = 1;
 720         *v  = (int *) (scicos_imp.funtyp);
 721     }
 722     else if (strcmp(what, "ztyp") == 0)
 723     {
 724         /* */
 725         *nv = nblk;
 726         *mv = 1;
 727         *v  = (int *) (scicos_imp.ztyp);
 728     }
 729     else if (strcmp(what, "cord") == 0)
 730     {
 731         /* */
 732         *nv = ncord;
 733         *mv = 2;
 734         *v  = (int *) (scicos_imp.cord);
 735     }
 736     else if (strcmp(what, "ncord") == 0)
 737     {
 738         /* */
 739         *nv = 1;
 740         *mv = 1;
 741         *v  = (int *) (scicos_imp.ncord);
 742     }
 743     else if (strcmp(what, "ordclk") == 0)
 744     {
 745         /* */
 746         *nv = (int)(scicos_imp.ordptr[nordptr] - 1);
 747         *mv = 2;
 748         *v  = (int *) (scicos_imp.ordclk);
 749     }
 750     else if (strcmp(what, "clkptr") == 0)
 751     {
 752         /* */
 753         *nv = (int)(nblk + 1);
 754         *mv = 1;
 755         *v  = (int *) (scicos_imp.clkptr);
 756     }
 757     else if (strcmp(what, "ordptr") == 0)
 758     {
 759         /* */
 760         *nv = nordptr;
 761         *mv = 1;
 762         *v  = (int *) (scicos_imp.ordptr);
 763     }
 764     else if (strcmp(what, "nordptr") == 0)
 765     {
 766         /* */
 767         *nv = 1;
 768         *mv = 1;
 769         *v  = (int *) (scicos_imp.nordptr);
 770     }
 771     else if (strcmp(what, "critev") == 0)
 772     {
 773         /* */
 774         *nv = (int)(scicos_imp.clkptr[nblk] - 1); /* !! a faire verifier !! */
 775         *mv = 1;
 776         *v  = (int *) (scicos_imp.critev);
 777     }
 778     else if (strcmp(what, "iwa") == 0)
 779     {
 780         /* */
 781         *nv = nevts; /* !! a faire verifier !! */
 782         *mv = 1;
 783         *v  = (int *) (scicos_imp.iwa);
 784     }
 785     else if (strcmp(what, "blocks") == 0)
 786     {
 787         /* */
 788         *nv = 1;
 789         *mv = 1;
 790         *v  = (scicos_block *) (scicos_imp.blocks);
 791     }
 792     else if (strcmp(what, "ng") == 0)
 793     {
 794         /* */
 795         *nv = 1;
 796         *mv = 1;
 797         *v  = (int *) (scicos_imp.ng);
 798     }
 799     else if (strcmp(what, "g") == 0)
 800     {
 801         /* g */
 802         *nv = ng;
 803         *mv = 1;
 804         *v  = (double *) (scicos_imp.g);
 805     }
 806     else if (strcmp(what, "t0") == 0)
 807     {
 808         /* g */
 809         *nv = 1;
 810         *mv = 1;
 811         *v  = (double *) (scicos_imp.t0);
 812     }
 813     else if (strcmp(what, "tf") == 0)
 814     {
 815         /* g */
 816         *nv = 1;
 817         *mv = 1;
 818         *v  = (double *) (scicos_imp.tf);
 819     }
 820     else if (strcmp(what, "Atol") == 0)
 821     {
 822         /* g */
 823         *nv = 1;
 824         *mv = 1;
 825         *v  = (double *) (scicos_imp.Atol);
 826     }
 827     else if (strcmp(what, "rtol") == 0)
 828     {
 829         /* g */
 830         *nv = 1;
 831         *mv = 1;
 832         *v  = (double *) (scicos_imp.rtol);
 833     }
 834     else if (strcmp(what, "ttol") == 0)
 835     {
 836         /* g */
 837         *nv = 1;
 838         *mv = 1;
 839         *v  = (double *) (scicos_imp.ttol);
 840     }
 841     else if (strcmp(what, "deltat") == 0)
 842     {
 843         /* g */
 844         *nv = 1;
 845         *mv = 1;
 846         *v  = (double *) (scicos_imp.deltat);
 847     }
 848     else if (strcmp(what, "hmax") == 0)
 849     {
 850         /* g */
 851         *nv = 1;
 852         *mv = 1;
 853         *v  = (double *) (scicos_imp.hmax);
 854     }
 855     else if (strcmp(what, "nelem") == 0)
 856     {
 857         /* g */
 858         *nv = 1;
 859         *mv = 1;
 860         *v  = (int*) (scicos_imp.nelem);
 861     }
 862     else if (strcmp(what, "outtb_elem") == 0)
 863     {
 864         /* */
 865         *nv = nelem;
 866         *mv = 2;
 867         *v  = (outtb_el *) (scicos_imp.outtb_elem);
 868     }
 869     else /*return FALSE_*/
 870     {
 871         return 0;
 872     }
 873
 874     /* return TRUE_ */
 875     return 1;
 876 }
 877 /*--------------------------------------------------------------------------*/
 878 /* Used in some scicos block */
 879 void C2F(getlabel)(int *kfun, char *label, int *n)
 880 /*int *n, *kfun;  length of the label as input n gives the max length expected*/
 881 {
 882     int k;
 883     int job = 1;
 884
 885     k = *kfun;
 886     if (*n > (int)(scicos_imp.izptr[k] - scicos_imp.izptr[k - 1]))
 887     {
 888         *n = (int)(scicos_imp.izptr[k] - scicos_imp.izptr[k - 1]);
 889     }
 890     if (*n > 0 )
 891     {
 892         F2C(cvstr)(n, &(scicos_imp.iz[scicos_imp.izptr[k - 1] - 1]), label, &job, *n);
 893     }
 894 }
 895
 896 /*never used, never interfaced */
 897 void C2F(getblockbylabel)(int *kfun, char **label, int *n)
 898 {
 899     int k, i, i0, nblk, n1;
 900     int job = 0;
 901     int lab[40];
 902
 903     nblk = scicos_imp.nblk[0];
 904     F2C(cvstr)(n, lab, *label, &job, *n);
 905
 906     *kfun = 0;
 907     for (k = 0; k < nblk; k++)
 908     {
 909         n1 = (int)(scicos_imp.izptr[k] - scicos_imp.izptr[k - 1]);
 910         if (n1 == *n)
 911         {
 912             i0 = scicos_imp.izptr[k - 1] - 1;
 913             i = 0;
 914             while ((lab[i] == scicos_imp.iz[i0 + i]) & (i < n1))
 915             {
 916                 i++;
 917             }
 918             if (i == n1)
 919             {
 920                 *kfun = k + 1;
 921                 return;
 922             }
 923         }
 924     }
 925 }
 926 /*--------------------------------------------------------------------------*/
 927 /*never used, never interfaced */
 928 int C2F(getsciblockbylabel)(int*kfun, int label[], int *n)
 929 {
 930     int k, i, i0, nblk, n1;
 931     if (scicos_imp.x == (double *)NULL)
 932     {
 933         return (2); /* undefined import table scicos is not running */
 934     }
 935     nblk = scicos_imp.nblk[0];
 936
 937     *kfun = 0;
 938     for (k = 0; k < nblk; k++)
 939     {
 940         n1 = (int)(scicos_imp.izptr[k] - scicos_imp.izptr[k - 1]);
 941         if (n1 == *n)
 942         {
 943             i0 = scicos_imp.izptr[k - 1] - 1;
 944             i = 0;
 945             while ((label[i] == scicos_imp.iz[i0 + i]) & (i < n1))
 946             {
 947                 i++;
 948             }
 949             if (i == n1)
 950             {
 951                 *kfun = k + 1;
 952                 return 0;
 953             }
 954         }
 955     }
 956     return 0;
 957 }
 958 /*--------------------------------------------------------------------------*/
 959 int C2F(getscilabel)(int *kfun, int label[], int *n)
 960 {
 961     int k, i;
 962     int *u, *y;
 963
 964     if (scicos_imp.x == (double *)NULL)
 965     {
 966         return (2); /* undefined import table scicos is not running */
 967     }
 968     k = *kfun;
 969     *n = (int)(scicos_imp.izptr[k] - scicos_imp.izptr[k - 1]);
 970     if (*n > 0 )
 971     {
 972         u = (int *) & (scicos_imp.iz[scicos_imp.izptr[k - 1] - 1]);
 973         y = label;
 974         for (i = 0; i < *n; i++)
 975         {
 976             *(y++) = *(u++);
 977         }
 978     }
 979     return (0);
 980 }
 981 /*--------------------------------------------------------------------------*/
 982 int C2F(getcurblock)()
 983 {
 984     return (C2F(curblk).kfun);
 985 }
 986 /*--------------------------------------------------------------------------*/
 987 /* used in fscope
 988  *
 989  * 30/06/06, Alan : Rewritte to preserve compatibility with fscope.f.
 990  * Only first element of matrix is delivred and converted to double data.
 991  *
 992  */
 993 void C2F(getouttb)(int *nsize, int *nvec, double *outtc)
 994 {
 995     /* declaration of ptr for typed port */
 996     void **outtbptr;            /*to store outtbptr*/
 997     SCSREAL_COP *outtbdptr;     /*to store double of outtb*/
 998     SCSINT8_COP *outtbcptr;     /*to store int8 of outtb*/
 999     SCSINT16_COP *outtbsptr;    /*to store int16 of outtb*/
1000     SCSINT32_COP *outtblptr;    /*to store int32 of outtb*/
1001     SCSUINT8_COP *outtbucptr;   /*to store unsigned int8 of outtb */
1002     SCSUINT16_COP *outtbusptr;  /*to store unsigned int16 of outtb */
1003     SCSUINT32_COP *outtbulptr;  /*to store unsigned int32 of outtb */
1004     int *outtb_nelem;           /*to store maximum number of element*/
1005     int outtbtyp;               /*to store type of data*/
1006     int *outtbsz;               /*to store size of data*/
1007     outtb_el *outtb_elem;       /*to store ptr of outtb_elem structure */
1008
1009     /*auxiliary variable*/
1010     int j, sz, lnk, pos;
1011
1012     /*get outtbptr from import struct.*/
1013     outtbptr = scicos_imp.outtbptr;
1014     /*get outtb_elem from import struct.*/
1015     outtb_elem = scicos_imp.outtb_elem;
1016     /*get outtbsz from import struct.*/
1017     outtbsz = scicos_imp.outtbsz;
1018     /*get max number of elem in outtb*/
1019     outtb_nelem = scicos_imp.nelem;
1020
1021     /*initialization of position in outtc */
1022     j = 0;
1023
1024     while (j < *nsize)
1025     {
1026         /*test to know if we are outside outtb_elem*/
1027         if (nvec[j] > (*outtb_nelem))
1028         {
1029             set_block_error(-1);
1030             return;
1031         }
1032
1033         lnk = outtb_elem[nvec[j] - 1].lnk;
1034         pos = outtb_elem[nvec[j] - 1].pos;
1035         outtbtyp = scicos_imp.outtbtyp[lnk];
1036
1037         /*double data type*/
1038         if (outtbtyp == SCSREAL_N)
1039         {
1040             outtbdptr = (SCSREAL_COP *)outtbptr[lnk];
1041             outtc[j] = (double)outtbdptr[pos];
1042             j++;
1043         }
1044         /*complex data type*/
1045         else if (outtbtyp == SCSCOMPLEX_N)
1046         {
1047             sz = outtbsz[2 * lnk] + outtbsz[(2 * lnk) + 1];
1048             outtbdptr = (SCSCOMPLEX_COP *)outtbptr[lnk];
1049             outtc[j] =  (double)outtbdptr[pos];
1050             /*outtc[j+1] =  (double)outtbdptr[pos+sz];*/
1051             /*j=j+2;*/
1052             j++;
1053         }
1054         /*int data type*/
1055         else
1056         {
1057             switch (outtbtyp)
1058             {
1059                 case SCSINT8_N   :
1060                     outtbcptr = (SCSINT8_COP *)outtbptr[lnk]; /*int8*/
1061                     outtc[j] = (double)outtbcptr[pos];
1062                     j++;
1063                     break;
1064
1065                 case SCSINT16_N  :
1066                     outtbsptr = (SCSINT16_COP *)outtbptr[lnk]; /*int16*/
1067                     outtc[j] = (double)outtbsptr[pos];
1068                     j++;
1069                     break;
1070
1071                 case SCSINT32_N  :
1072                     outtblptr = (SCSINT32_COP *)outtbptr[lnk]; /*int32*/
1073                     outtc[j] = (double)outtblptr[pos];
1074                     j++;
1075                     break;
1076
1077                 case SCSUINT8_N  :
1078                     outtbucptr = (SCSUINT8_COP *)outtbptr[lnk]; /*uint8*/
1079                     outtc[j] = (double)outtbucptr[pos];
1080                     j++;
1081                     break;
1082
1083                 case SCSUINT16_N :
1084                     outtbusptr = (SCSUINT16_COP *)outtbptr[lnk]; /*uint16*/
1085                     outtc[j] = (double)outtbusptr[pos];
1086                     j++;
1087                     break;
1088
1089                 case SCSUINT32_N :
1090                     outtbulptr = (SCSUINT32_COP *)outtbptr[lnk]; /*uint32*/
1091                     outtc[j] = (double)outtbulptr[pos];
1092                     j++;
1093                     break;
1094
1095                 default        :
1096                     outtc[j] = 0;
1097                     j++;
1098                     break;
1099             }
1100         }
1101     }
1102 }
1103 /*--------------------------------------------------------------------------*/