Computational routine
eng
readf4
#include "scicos_block.h"
#include <math.h>
#include "../machine.h"
/* Common Block Declarations */
int bfrdr();
struct {
double stk[2];
} stack_;
#define stack_1 stack_
struct {
int bot, top, idstk[60000] /* was [6][10000] */, lstk[10000],
leps, bbot, bot0, infstk[10000], gbot, gtop, isiz;
} vstk_;
#define vstk_1 vstk_
struct {
int ids[24576] /* was [6][4096] */, pstk[4096], rstk[4096], pt, niv,
macr, paus, icall, krec;
} recu_;
#define recu_1 recu_
struct {
int ddt, err, lct[8], lin[65536], lpt[6], hio, rio, wio, rte, wte;
} iop_;
#define iop_1 iop_
struct {
int err1, err2, errct, toperr, errpt, ieee, catch__;
} errgst_;
#define errgst_1 errgst_
struct {
int sym, syn[6], char1, fin, fun, lhs, rhs, ran[2], comp[3];
} com_;
#define com_1 com_
struct {
char alfa[63], alfb[63], buf[4096];
} cha1_;
#define cha1_1 cha1_
struct {
int wmac, lcntr, nmacs, macnms[600] /* was [6][100] */, lgptrs[
101], bptlg[1000];
} dbg_;
#define dbg_1 dbg_
struct {
int lbot, ie, is, ipal, nbarg, ladr[1024];
} adre_;
#define adre_1 adre_
struct {
int nbvars, iwhere[1024], nbrows[1024], nbcols[1024], itflag[1024],
ntypes[1024], lad[1024], ladc[1024], lhsvar[1024];
} intersci_;
typedef struct
{ long int cierr;
long int ciunit;
long int ciend;
char *cifmt;
long int cirec;
} cilist;
#define intersci_1 intersci_
typedef char *address;
typedef struct { double r, i; } doublecomplex;
#ifndef max
#define max(a,b) ((a) >= (b) ? (a) : (b))
#endif
/* Table of constant values */
static int c__1 = 1;
static int c__3 = 3;
static int c__2 = 2;
int readf4(scicos_block *block,int flag)
{
int nz=block->nz;
double* z__=block->z;
double* y=block->outptr[0];
int* ny=block->outsz;
int* ipar=block->ipar;
double *tvec=block->evout;
double t=GetScicosTime(block);
/* System generated locals */
address a__1[3], a__2[2];
int i__1, i__2[3], i__3[2];
char ch__1[4118], ch__2[4115];
/* Builtin functions */
int s_cat();
/* Local variables */
static int mode[2], lfil, kmax;
#define cstk ((char *)&stack_1)
static int ierr;
#define istk ((int *)&stack_1)
static int ievt, lfmt;
#define sstk ((float *)&stack_1)
#define zstk ((doublecomplex *)&stack_1)
static int k, n;
extern int dcopy_();
static int lunit;
extern int cvstr_();
static int io, no;
extern int basout_(), clunit_();
/* Copyright INRIA
Scicos block simulator
write read from a binary or formatted file
include '../stack.h'
ipar(1) = lfil : file name length
ipar(2) = lfmt : format length (0) if binary file
ipar(3) = ievt : 1 if each data have a an associated time
ipar(4) = N : buffer length
ipar(5:4+lfil) = character codes for file name
ipar(5+lfil:4+lfil+lfmt) = character codes for format if any
ipar(5+lfil+lfmt:5+lfil+lfmt+ny+ievt) = reading mask */
/* Parameter adjustments */
--y;
--ipar;
--tvec;
--z__;
/* Function Body */
if (flag == 1) {
/* discrete state */
n = ipar[4];
k = (int) z__[1];
ievt = ipar[3];
kmax = (int) z__[2];
lunit = (int) z__[3];
if (k + 1 > kmax && kmax == n) {
/* output */
dcopy_(ny, &z__[n * ievt + 3 + k], &n, &y[1], &c__1);
/* . read a new buffer */
no = (nz - 3) / n;
bfrdr(&lunit, &ipar[1], &z__[4], &no, &kmax, &ierr);
if (ierr != 0) {
goto L110;
}
z__[1] = 1.;
z__[2] = (double) kmax;
} else if (k < kmax) {
/* output */
dcopy_(ny, &z__[n * ievt + 3 + k], &n, &y[1], &c__1);
z__[1] += 1.;
} else if (k+1> kmax) {
dcopy_(ny, &z__[n * ievt + 3 + kmax], &n, &y[1], &c__1);
}
} else if (flag == 3) {
n = ipar[4];
k = (int) z__[1];
kmax = (int) z__[2];
if (k > kmax && kmax < n) {
tvec[1] = t - 1.;
} else {
tvec[1] = z__[k + 3];
}
} else if (flag == 4) {
/* file opening */
lfil = ipar[1];
ievt = ipar[3];
n = ipar[4];
cvstr_(&lfil, &ipar[5], cha1_1.buf, &c__1, (SCSINT16_COP)4096);
lfmt = ipar[2];
lunit = 0;
if (lfmt > 0) {
mode[0] = 1;
mode[1] = 0;
clunit_(&lunit, cha1_1.buf, mode, lfil);
if (iop_1.err > 0) {
goto L100;
}
} else {
mode[0] = 101;
mode[1] = 0;
clunit_(&lunit, cha1_1.buf, mode, lfil);
if (iop_1.err > 0) {
goto L100;
}
}
z__[3] = (double) lunit;
/* buffer initialisation */
no = (nz - 3) / n;
bfrdr(&lunit, &ipar[1], &z__[4], &no, &kmax, &ierr);
if (ierr != 0) {
goto L110;
}
z__[1] = 1.;
z__[2] = (double) kmax;
} else if (flag == 5) {
lfil = ipar[1];
n = ipar[4];
k = (int) z__[1];
lunit = (int) z__[3];
if (lunit == 0) {
return 0;
}
i__1 = -lunit;
clunit_(&i__1, cha1_1.buf, mode, lfil);
if (iop_1.err > 0) {
goto L100;
}
z__[3] = 0.;
}
return 0;
L100:
iop_1.err = 0;
lfil = ipar[1];
/* Writing concatenation */
i__2[0] = 5, a__1[0] = "File ";
i__2[1] = lfil, a__1[1] = cha1_1.buf;
i__2[2] = 17, a__1[2] = " Cannot be opened";
s_cat(ch__1, a__1, i__2, &c__3, (SCSINT16_COP)4118);
basout_(&io, &iop_1.wte, ch__1, lfil + 22);
flag = -1;
return 0;
L110:
lfil = ipar[1];
cvstr_(&lfil, &ipar[5], cha1_1.buf, &c__1, (SCSINT16_COP)4096);
i__1 = -lunit;
clunit_(&i__1, cha1_1.buf, mode, lfil);
/* Writing concatenation */
i__3[0] = 19, a__2[0] = "Read error on file ";
i__3[1] = lfil, a__2[1] = cha1_1.buf;
s_cat(ch__2, a__2, i__3, &c__2, (SCSINT16_COP)4115);
basout_(&io, &iop_1.wte, ch__2, lfil + 19);
flag = -1;
return 0;
} /* readf */
#undef zstk
#undef sstk
#undef istk
#undef cstk
int bfrdr(lunit, ipar, z__, no, kmax, ierr)
int *lunit, *ipar;
double *z__;
int *no, *kmax, *ierr;
{
/* System generated locals */
int i__1, i__2, i__3;
cilist ci__1;
/* Builtin functions */
int s_rsue(), do_uio(), e_rsue(), s_rsfe(), do_fio(), e_rsfe();
/* Local variables */
#define cstk ((char *)&stack_1)
static int lfmt;
#define istk ((int *)&stack_1)
static int ievt;
#define sstk ((float *)&stack_1)
#define zstk ((doublecomplex *)&stack_1)
static int i__, j, n, imask;
extern /* Subroutine */ int cvstr_();
static int mm;
static double tmp[100];
/* Fortran I/O blocks */
static cilist io___26 = { 1, 0, 1, 0, 0 };
/* *------------------------------------------------------------------ */
/* Parameter adjustments */
--z__;
--ipar;
/* Function Body */
ievt = ipar[3];
n = ipar[4];
/* no=(nz-3)/N */
/* maximum number of value to read */
imask = ipar[1] + 5 + ipar[2];
if (ievt == 0) {
++imask;
}
mm = 0;
i__1 = *no - 1;
for (i__ = 0; i__ <= i__1; ++i__) {
/* Computing MAX */
i__2 = mm, i__3 = ipar[imask + i__];
mm = max(i__2,i__3);
/* L10: */
}
lfmt = ipar[2];
*kmax = 0;
if (lfmt == 0) {
/* unformatted read */
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
io___26.ciunit = *lunit;
i__2 = s_rsue(&io___26);
if (i__2 != 0) {
goto L100001;
}
i__3 = mm;
for (j = 1; j <= i__3; ++j) {
i__2 = do_uio(&c__1, (char *)&tmp[j - 1], (SCSINT16_COP)sizeof(
double));
if (i__2 != 0) {
goto L100001;
}
}
i__2 = e_rsue();
L100001:
if (i__2 < 0) {
goto L20;
}
if (i__2 > 0) {
goto L100;
}
i__2 = *no - 1;
for (j = 0; j <= i__2; ++j) {
z__[j * n + i__] = tmp[ipar[imask + j] - 1];
/* L11: */
}
++(*kmax);
/* L12: */
}
} else {
/* formatted read */
cvstr_(&ipar[2], &ipar[ipar[1] + 5], cha1_1.buf, &c__1, (SCSINT16_COP)4096);
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
ci__1.cierr = 1;
ci__1.ciend = 1;
ci__1.ciunit = *lunit;
ci__1.cifmt = cha1_1.buf;
i__2 = s_rsfe(&ci__1);
if (i__2 != 0) {
goto L100002;
}
i__3 = mm;
for (j = 1; j <= i__3; ++j) {
i__2 = do_fio(&c__1, (char *)&tmp[j - 1], (SCSINT16_COP)sizeof(
double));
if (i__2 != 0) {
goto L100002;
}
}
i__2 = e_rsfe();
L100002:
if (i__2 < 0) {
goto L20;
}
if (i__2 > 0) {
goto L100;
}
i__2 = *no - 1;
for (j = 0; j <= i__2; ++j) {
z__[j * n + i__] = tmp[ipar[imask + j] - 1];
/* L13: */
}
++(*kmax);
/* L14: */
}
}
L20:
*ierr = 0;
return 0;
L100:
*ierr = 1;
return 0;
} /* bfrdr */
#undef zstk
#undef sstk
#undef istk
#undef cstk