#include "scicos_block.h"#include <math.h>#include "machine.h"Include dependency graph for writef4.c:
Go to the source code of this file.
Data Structures | |
| struct | cilist |
| struct | doublecomplex |
Defines | |
| #define | stack_1 stack_ |
| #define | vstk_1 vstk_ |
| #define | recu_1 recu_ |
| #define | iop_1 iop_ |
| #define | errgst_1 errgst_ |
| #define | com_1 com_ |
| #define | cha1_1 cha1_ |
| #define | dbg_1 dbg_ |
| #define | adre_1 adre_ |
| #define | intersci_1 intersci_ |
| #define | cstk ((char *)&stack_1) |
| #define | istk ((int *)&stack_1) |
| #define | sstk ((real *)&stack_1) |
| #define | zstk ((doublecomplex *)&stack_1) |
Typedefs | |
| typedef char * | address |
Functions | |
| int | writef4 (scicos_block *block, int flag) |
Variables | |
| struct { | |
| double stk [2] | |
| } | stack_ |
| struct { | |
| int bot | |
| int top | |
| int idstk [60000] | |
| int lstk [10000] | |
| int leps | |
| int bbot | |
| int bot0 | |
| int infstk [10000] | |
| int gbot | |
| int gtop | |
| int isiz | |
| } | vstk_ |
| struct { | |
| int ids [24576] | |
| int pstk [4096] | |
| int rstk [4096] | |
| int pt | |
| int niv | |
| int macr | |
| int paus | |
| int icall | |
| int krec | |
| } | recu_ |
| struct { | |
| int ddt | |
| int err | |
| int lct [8] | |
| int lin [65536] | |
| int lpt [6] | |
| int hio | |
| int rio | |
| int wio | |
| int rte | |
| int wte | |
| } | iop_ |
| struct { | |
| int err1 | |
| int err2 | |
| int errct | |
| int toperr | |
| int errpt | |
| int ieee | |
| int catch__ | |
| } | errgst_ |
| struct { | |
| int sym | |
| int syn [6] | |
| int char1 | |
| int fin | |
| int fun | |
| int lhs | |
| int rhs | |
| int ran [2] | |
| int comp [3] | |
| } | com_ |
| struct { | |
| char alfa [63] | |
| char alfb [63] | |
| char buf [4096] | |
| } | cha1_ |
| struct { | |
| int wmac | |
| int lcntr | |
| int nmacs | |
| int macnms [600] | |
| int lgptrs [101] | |
| int bptlg [1000] | |
| } | dbg_ |
| struct { | |
| int lbot | |
| int ie | |
| int is | |
| int ipal | |
| int nbarg | |
| int ladr [1024] | |
| } | adre_ |
| struct { | |
| int nbvars | |
| int iwhere [1024] | |
| int nbrows [1024] | |
| int nbcols [1024] | |
| int itflag [1024] | |
| int ntypes [1024] | |
| int lad [1024] | |
| int ladc [1024] | |
| int lhsvar [1024] | |
| } | intersci_ |
| static int | c__1 = 1 |
| static double | c_b12 = 0. |
| static int | c__3 = 3 |
| #define cstk ((char *)&stack_1) |
| #define istk ((int *)&stack_1) |
| #define sstk ((real *)&stack_1) |
| #define zstk ((doublecomplex *)&stack_1) |
| int writef4 | ( | scicos_block * | block, | |
| int | flag | |||
| ) |
Definition at line 90 of file writef4.c.
References c__1, c__3, c_b12, cha1_1, cilist::cierr, cilist::cifmt, cilist::ciunit, do_fio(), do_uio(), e_wsfe(), e_wsue(), get_scicos_time(), i__, iflag, scicos_block::inptr, scicos_block::insz, int, iop_1, scicos_block::ipar, j, lunit, mode, n, scicos_block::nevprt, nu, s_cat(), s_wsfe(), s_wsue(), t, and scicos_block::z.
00091 { 00092 double* z__=block->z; 00093 double* u=block->inptr[0]; 00094 int* nu=block->insz; 00095 int* ipar=block->ipar; 00096 int nevprt=block->nevprt; 00097 double t=get_scicos_time(); 00098 00099 /* System generated locals */ 00100 address a__1[3]; 00101 int i__1, i__2, i__3, i__4[3]; 00102 char ch__1[4118]; 00103 cilist ci__1; 00104 00105 /* Builtin functions */ 00106 int s_wsfe(), do_fio(), e_wsfe(), s_wsue(), do_uio(), e_wsue(); 00107 int s_cat(); 00108 00109 /* Local variables */ 00110 static int mode[2], lfil; 00111 extern int dset_(); 00112 static int lfmt; 00113 #define cstk ((char *)&stack_1) 00114 #define istk ((int *)&stack_1) 00115 #define sstk ((real *)&stack_1) 00116 #define zstk ((doublecomplex *)&stack_1) 00117 static int i__, j, k, n, iflag, lunit; 00118 extern int cvstr_(); 00119 static int io; 00120 extern int basout_(), clunit_(); 00121 00122 /* Fortran I/O blocks */ 00123 static cilist io___10 = { 1, 0, 0, 0, 0 }; 00124 static cilist io___14 = { 0, 0, 0, 0, 0 }; 00125 00126 00127 /* Copyright INRIA */ 00128 /* Scicos block simulator */ 00129 /* write input to a binary or formatted file */ 00130 /* ipar(1) = lfil : file name length */ 00131 /* ipar(2) = lfmt : format length (0) if binary file */ 00132 /* ipar(3) unused */ 00133 /* ipar(4) = N : buffer length */ 00134 /* ipar(5:4+lfil) = character codes for file name */ 00135 /* ipar(5+lfil:4+lfil+lfmt) = character codes for format if any */ 00136 00137 /* Copyright INRIA */ 00138 /* *------------------------------------------------------------------ */ 00139 /* vsiz size of internal scilab stack */ 00140 00141 /* bsiz size of internal chain buf */ 00142 00143 /* isizt maximum number of scilab variables global and local */ 00144 /* isiz maximum number of scilab local variables */ 00145 /* psiz defines recursion size */ 00146 /* lsiz dim. of vector containing the command line */ 00147 /* nlgh length of variable names */ 00148 /* csiz used for character coding */ 00149 /* intersiz used in interfaces */ 00150 /* *------------------------------------------------------------------- */ 00151 /* c (DLL Digital Visual Fortran) */ 00152 /* DEC$ IF DEFINED (FORDLL) */ 00153 /* DEC$ ATTRIBUTES DLLIMPORT:: /stack/, /vstk/, /recu/, /iop/ */ 00154 /* DEC$ ATTRIBUTES DLLIMPORT:: /errgst/, /com/, /adre/ */ 00155 /* DEC$ ATTRIBUTES DLLIMPORT:: /intersci/ ,/cha1/ */ 00156 /* DEC$ ENDIF */ 00157 /* --------------------------------------------------------------- */ 00158 00159 /* *------------------------------------------------------------------ */ 00160 00161 /* Parameter adjustments */ 00162 --u; 00163 --ipar; 00164 --z__; 00165 00166 /* Function Body */ 00167 n = ipar[4]; 00168 k = (int) z__[1]; 00169 lunit = (int) z__[2]; 00170 00171 if (flag == 2 && nevprt > 0) { 00172 /* add new point to the buffer */ 00173 ++k; 00174 z__[k + 2] = t; 00175 i__1 = *nu; 00176 for (i__ = 1; i__ <= i__1; ++i__) { 00177 z__[n + 2 + (i__ - 1) * n + k] = u[i__]; 00178 /* L1: */ 00179 } 00180 z__[1] = (double) k; 00181 if (k < n) { 00182 return 0; 00183 } 00184 /* write on the file */ 00185 if (ipar[2] > 0) { 00186 /* . formatted write */ 00187 cvstr_(&ipar[2], &ipar[ipar[1] + 5], cha1_1.buf, &c__1, (short) 00188 4096); 00189 i__1 = k; 00190 for (j = 1; j <= i__1; ++j) { 00191 ci__1.cierr = 1; 00192 ci__1.ciunit = lunit; 00193 ci__1.cifmt = cha1_1.buf; 00194 i__2 = s_wsfe(&ci__1); 00195 if (i__2 != 0) { 00196 goto L100; 00197 } 00198 i__3 = *nu; 00199 for (i__ = 0; i__ <= i__3; ++i__) { 00200 i__2 = do_fio(&c__1, (char *)&z__[n + 2 + (i__ - 1) * n + 00201 j], (short)sizeof(double)); 00202 if (i__2 != 0) { 00203 goto L100; 00204 } 00205 } 00206 i__2 = e_wsfe(); 00207 if (i__2 != 0) { 00208 goto L100; 00209 } 00210 /* L10: */ 00211 } 00212 } else { 00213 /* . unformatted write */ 00214 i__1 = k; 00215 for (j = 1; j <= i__1; ++j) { 00216 io___10.ciunit = lunit; 00217 i__2 = s_wsue(&io___10); 00218 if (i__2 != 0) { 00219 goto L100; 00220 } 00221 i__3 = *nu; 00222 for (i__ = 0; i__ <= i__3; ++i__) { 00223 i__2 = do_uio(&c__1, (char *)&z__[n + 2 + (i__ - 1) * n + 00224 j], (short)sizeof(double)); 00225 if (i__2 != 0) { 00226 goto L100; 00227 } 00228 } 00229 i__2 = e_wsue(); 00230 if (i__2 != 0) { 00231 goto L100; 00232 } 00233 /* L11: */ 00234 } 00235 } 00236 z__[1] = 0.; 00237 } else if (flag == 4) { 00238 /* file opening */ 00239 lfil = ipar[1]; 00240 cvstr_(&lfil, &ipar[5], cha1_1.buf, &c__1, (short)4096); 00241 lfmt = ipar[2]; 00242 lunit = 0; 00243 if (lfmt > 0) { 00244 mode[0] = 3; 00245 mode[1] = 0; 00246 clunit_(&lunit, cha1_1.buf, mode, lfil); 00247 if (iop_1.err > 0) { 00248 goto L100; 00249 } 00250 } else { 00251 mode[0] = 103; 00252 mode[1] = 0; 00253 clunit_(&lunit, cha1_1.buf, mode, lfil); 00254 if (iop_1.err > 0) { 00255 goto L100; 00256 } 00257 } 00258 z__[1] = 0.; 00259 z__[2] = (double) lunit; 00260 z__[3] = t; 00261 i__1 = *nu * n; 00262 dset_(&i__1, &c_b12, &z__[4], &c__1); 00263 } else if (flag == 5) { 00264 if (lunit == 0) { 00265 return 0; 00266 } 00267 if (k >= 1) { 00268 /* write on the file */ 00269 lfmt = ipar[2]; 00270 if (lfmt > 0) { 00271 /* . formatted write */ 00272 cvstr_(&lfmt, &ipar[ipar[1] + 5], cha1_1.buf, &c__1, (short) 00273 4096); 00274 i__1 = k; 00275 for (j = 1; j <= i__1; ++j) { 00276 ci__1.cierr = 0; 00277 ci__1.ciunit = lunit; 00278 ci__1.cifmt = cha1_1.buf; 00279 s_wsfe(&ci__1); 00280 i__2 = *nu; 00281 for (i__ = 0; i__ <= i__2; ++i__) { 00282 do_fio(&c__1, (char *)&z__[n + 2 + (i__ - 1) * n + j], 00283 (short)sizeof(double)); 00284 } 00285 e_wsfe(); 00286 /* L20: */ 00287 } 00288 } else { 00289 /* . unformatted write */ 00290 i__1 = k; 00291 for (j = 1; j <= i__1; ++j) { 00292 io___14.ciunit = lunit; 00293 s_wsue(&io___14); 00294 i__2 = *nu; 00295 for (i__ = 0; i__ <= i__2; ++i__) { 00296 do_uio(&c__1, (char *)&z__[n + 2 + (i__ - 1) * n + j], 00297 (short)sizeof(double)); 00298 } 00299 e_wsue(); 00300 /* L21: */ 00301 } 00302 } 00303 } 00304 lfil = ipar[1]; 00305 i__1 = -lunit; 00306 clunit_(&i__1, cha1_1.buf, mode, lfil); 00307 if (iop_1.err > 0) { 00308 goto L100; 00309 } 00310 z__[2] = 0.; 00311 } 00312 return 0; 00313 L100: 00314 iop_1.err = 0; 00315 /* Writing concatenation */ 00316 i__4[0] = 5, a__1[0] = "File "; 00317 i__4[1] = lfil, a__1[1] = cha1_1.buf; 00318 i__4[2] = 17, a__1[2] = " Cannot be opened"; 00319 s_cat(ch__1, a__1, i__4, &c__3, (short)4118); 00320 basout_(&io, &iop_1.wte, ch__1, lfil + 22); 00321 iflag = -1; 00322 return 0; 00323 } /* writef_ */
Here is the call graph for this function:
| struct { ... } adre_ |
| struct { ... } cha1_ |
| struct { ... } com_ |
| struct { ... } dbg_ |
| struct { ... } errgst_ |
| struct { ... } intersci_ |
| struct { ... } iop_ |
| struct { ... } recu_ |
| struct { ... } stack_ |
| struct { ... } vstk_ |
1.5.1