00439 { MAIN__ (); return 0; }

00375 {
00376     /* System generated locals */
00377     integer ret_val, i__1;
00378     doublereal d__1;
00379     icilist ici__1;
00380 
00381     /* Builtin functions */
00382     integer s_rsli(icilist *), do_lio(integer *, integer *, char *, ftnlen), 
00383             e_rsli(void);
00384 
00385     /* Local variables */
00386     static integer ierr;
00387     static doublereal rval[26];
00388     static integer itry, i__;
00389 
00390 
00391 /*  Find how many columns there are in the string CLINE */
00392 
00393 
00394 
00395 /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00396  */
00397 
00398     for (itry = 1; itry <= 26; ++itry) {
00399         i__1 = itry;
00400         for (i__ = 1; i__ <= i__1; ++i__) {
00401             rval[i__ - 1] = -9.876543e26;
00402 /* L50: */
00403         }
00404         ici__1.icierr = 1;
00405         ici__1.iciend = 1;
00406         ici__1.icirnum = 1;
00407         ici__1.icirlen = cline_len;
00408         ici__1.iciunit = cline;
00409         ici__1.icifmt = 0;
00410         ierr = s_rsli(&ici__1);
00411         if (ierr != 0) {
00412             goto L100003;
00413         }
00414         i__1 = itry;
00415         for (i__ = 1; i__ <= i__1; ++i__) {
00416             ierr = do_lio(&c__5, &c__1, (char *)&rval[i__ - 1], (ftnlen)
00417                     sizeof(doublereal));
00418             if (ierr != 0) {
00419                 goto L100003;
00420             }
00421         }
00422         ierr = e_rsli();
00423 L100003:
00424         if (ierr != 0) {
00425             goto L200;
00426         }
00427         if ((d__1 = rval[itry - 1] / -9.876543e26 - 1., abs(d__1)) <= 1e-11) {
00428             goto L200;
00429         }
00430 /* L100: */
00431     }
00432     itry = 27;
00433 
00434 L200:
00435     ret_val = itry - 1;
00436     return ret_val;
00437 } /* inumc_ */

00016 {
00017     /* Format strings */
00018     static char fmt_101[] = "(\002 output\002,i1,\002> \002$)";
00019     static char fmt_111[] = "(a)";
00020     static char fmt_1001[] = "(\002 Must enter at least one output column"
00021             "!\002)";
00022     static char fmt_1002[] = "(\002 Enter \002,a6,\002 filename           :"
00023             " \002$)";
00024     static char fmt_1019[] = "(\002*** cannot read numbers from that file "
00025             "***\002)";
00026     static char fmt_1029[] = "(/\002 *** max column # in expressions =\002,i"
00027             "3/\002 ***              in input file  =\002,i3/\002 *** trailin"
00028             "g columns set to zero ***\002/)";
00029     static char fmt_1031[] = "(\002 OK, enter number of rows to run: \002$)";
00030     static char fmt_1051[] = "(\002 stopping expression (end < 0) : \002$)";
00031     static char fmt_1201[] = "(9(1x,1pg20.13))";
00032 
00033     /* System generated locals */
00034     integer i__1, i__2, i__3;
00035     olist o__1;
00036     cllist cl__1;
00037     alist al__1;
00038     static doublereal equiv_0[1];
00039 
00040     /* Builtin functions */
00041     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
00042              s_rsfe(cilist *), e_rsfe(void), s_cmp(char *, char *, ftnlen, 
00043             ftnlen), f_open(olist *), f_rew(alist *), f_clos(cllist *), 
00044             s_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), 
00045             e_rsle(void);
00046 
00047     /* Local variables */
00048     static integer ncol, ierr, num_code__[26], irow, nout, nrow;
00049     static doublereal rout[9], r8val[26];
00050     static integer i__, ncmax;
00051     extern integer inumc_(char *, ftnlen);
00052 #define c8 ((char *)equiv_0)
00053 #define r8 (equiv_0)
00054     static char c_code__[8*200*26];
00055     static integer ialpha;
00056     static char c_expr__[666];
00057     extern /* Subroutine */ int parser_(char *, logical *, integer *, char *, 
00058             ftnlen, ftnlen);
00059     static logical lstout;
00060     extern doublereal pareval_(integer *, char *, doublereal *, ftnlen);
00061     static char c_cstop__[8*200];
00062     static integer n_cstop__;
00063     static doublereal r_cstop__;
00064 
00065     /* Fortran I/O blocks */
00066     static cilist io___8 = { 0, 6, 0, fmt_101, 0 };
00067     static cilist io___9 = { 1, 5, 1, fmt_111, 0 };
00068     static cilist io___13 = { 0, 6, 0, fmt_1001, 0 };
00069     static cilist io___15 = { 0, 6, 0, fmt_1002, 0 };
00070     static cilist io___16 = { 1, 5, 1, fmt_111, 0 };
00071     static cilist io___18 = { 0, 77, 0, fmt_111, 0 };
00072     static cilist io___19 = { 0, 6, 0, fmt_1019, 0 };
00073     static cilist io___20 = { 0, 6, 0, fmt_1029, 0 };
00074     static cilist io___21 = { 0, 6, 0, fmt_1031, 0 };
00075     static cilist io___22 = { 0, 5, 0, 0, 0 };
00076     static cilist io___24 = { 0, 6, 0, fmt_1002, 0 };
00077     static cilist io___25 = { 1, 5, 1, fmt_111, 0 };
00078     static cilist io___28 = { 0, 6, 0, fmt_1051, 0 };
00079     static cilist io___29 = { 1, 5, 1, fmt_111, 0 };
00080     static cilist io___32 = { 1, 77, 1, 0, 0 };
00081     static cilist io___35 = { 0, 6, 0, fmt_1201, 0 };
00082     static cilist io___36 = { 0, 78, 0, fmt_1201, 0 };
00083 
00084 
00085 
00086 
00087 /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00088  */
00089 
00090     for (i__ = 1; i__ <= 26; ++i__) {
00091         r8val[i__ - 1] = 0.;
00092 /* L90: */
00093     }
00094 
00095     nout = 1;
00096     ncmax = 0;
00097     ialpha = 'A' - 1;
00098 /* .......................................................................
00099  */
00100 L100:
00101     s_wsfe(&io___8);
00102     do_fio(&c__1, (char *)&nout, (ftnlen)sizeof(integer));
00103     e_wsfe();
00104     i__1 = s_rsfe(&io___9);
00105     if (i__1 != 0) {
00106         goto L1000;
00107     }
00108     i__1 = do_fio(&c__1, c_expr__, 666L);
00109     if (i__1 != 0) {
00110         goto L1000;
00111     }
00112     i__1 = e_rsfe();
00113     if (i__1 != 0) {
00114         goto L1000;
00115     }
00116     if (s_cmp(c_expr__, " ", 666L, 1L) == 0 || s_cmp(c_expr__, "end", 666L, 
00117             3L) == 0 || s_cmp(c_expr__, "exit", 666L, 4L) == 0 || s_cmp(
00118             c_expr__, "quit", 666L, 4L) == 0) {
00119         goto L1000;
00120     }
00121 
00122     parser_(c_expr__, &c_true, &num_code__[nout - 1], c_code__ + (nout * 200 
00123             - 200 << 3), 666L, 8L);
00124 
00125     if (num_code__[nout - 1] <= 0) {
00126         goto L100;
00127     }
00128 
00129 /*  find maximum symbol (column) reference */
00130 
00131     i__1 = num_code__[nout - 1] - 1;
00132     for (i__ = 1; i__ <= i__1; ++i__) {
00133         if (s_cmp(c_code__ + (i__ + nout * 200 - 201 << 3), "PUSHSYM", 8L, 7L)
00134                  == 0) {
00135 /* Computing MAX */
00136             i__2 = ncmax, i__3 = *(unsigned char *)&c_code__[(i__ + 1 + nout *
00137                      200 - 201) * 8] - ialpha;
00138             ncmax = max(i__2,i__3);
00139         }
00140 /* L200: */
00141     }
00142 
00143     ++nout;
00144     if (nout <= 9) {
00145         goto L100;
00146     }
00147 /* ---------------------------------------------------------------------- 
00148 */
00149 L1000:
00150     --nout;
00151     if (nout <= 0) {
00152         s_wsfe(&io___13);
00153         e_wsfe();
00154         goto L9000;
00155     }
00156 
00157 L1010:
00158     ncol = 0;
00159     s_wsfe(&io___15);
00160     do_fio(&c__1, "input", 5L);
00161     e_wsfe();
00162     i__1 = s_rsfe(&io___16);
00163     if (i__1 != 0) {
00164         goto L100001;
00165     }
00166     i__1 = do_fio(&c__1, c_expr__, 666L);
00167     if (i__1 != 0) {
00168         goto L100001;
00169     }
00170     i__1 = e_rsfe();
00171 L100001:
00172     if (i__1 < 0) {
00173         goto L9000;
00174     }
00175     if (i__1 > 0) {
00176         goto L1010;
00177     }
00178     if (*(unsigned char *)c_expr__ == ' ') {
00179         goto L1030;
00180     }
00181 
00182     o__1.oerr = 1;
00183     o__1.ounit = 77;
00184     o__1.ofnmlen = 666;
00185     o__1.ofnm = c_expr__;
00186     o__1.orl = 0;
00187     o__1.osta = "OLD";
00188     o__1.oacc = 0;
00189     o__1.ofm = "FORMATTED";
00190     o__1.oblnk = 0;
00191     ierr = f_open(&o__1);
00192     if (ierr != 0) {
00193         goto L1010;
00194     }
00195 
00196 /*  Find out how many columns of numbers are in this file by */
00197 /*  reading the first line */
00198 
00199     s_rsfe(&io___18);
00200     do_fio(&c__1, c_expr__, 666L);
00201     e_rsfe();
00202     al__1.aerr = 0;
00203     al__1.aunit = 77;
00204     f_rew(&al__1);
00205     ncol = inumc_(c_expr__, 666L);
00206 /* cc      write(*,7707) ncol */
00207 /* cc7707  format('inumc returns ',I5) */
00208     if (ncol <= 0) {
00209         s_wsfe(&io___19);
00210         e_wsfe();
00211         cl__1.cerr = 0;
00212         cl__1.cunit = 77;
00213         cl__1.csta = 0;
00214         f_clos(&cl__1);
00215         goto L1010;
00216     }
00217 
00218     if (ncmax > ncol) {
00219         s_wsfe(&io___20);
00220         do_fio(&c__1, (char *)&ncmax, (ftnlen)sizeof(integer));
00221         do_fio(&c__1, (char *)&ncol, (ftnlen)sizeof(integer));
00222         e_wsfe();
00223     }
00224     ncol = min(ncol,ncmax);
00225 
00226 L1030:
00227     if (ncol == 0) {
00228         s_wsfe(&io___21);
00229         e_wsfe();
00230         s_rsle(&io___22);
00231         do_lio(&c__3, &c__1, (char *)&nrow, (ftnlen)sizeof(integer));
00232         e_rsle();
00233         if (nrow <= 0) {
00234             goto L1030;
00235         }
00236     } else {
00237         nrow = 999999;
00238     }
00239 
00240     s_wsfe(&io___24);
00241     do_fio(&c__1, "output", 6L);
00242     e_wsfe();
00243     i__1 = s_rsfe(&io___25);
00244     if (i__1 != 0) {
00245         goto L100002;
00246     }
00247     i__1 = do_fio(&c__1, c_expr__, 666L);
00248     if (i__1 != 0) {
00249         goto L100002;
00250     }
00251     i__1 = e_rsfe();
00252 L100002:
00253     if (i__1 < 0) {
00254         goto L9000;
00255     }
00256     if (i__1 > 0) {
00257         goto L1030;
00258     }
00259 
00260     lstout = *(unsigned char *)c_expr__ == ' ';
00261 
00262     if (! lstout) {
00263         o__1.oerr = 1;
00264         o__1.ounit = 78;
00265         o__1.ofnmlen = 666;
00266         o__1.ofnm = c_expr__;
00267         o__1.orl = 0;
00268         o__1.osta = "NEW";
00269         o__1.oacc = 0;
00270         o__1.ofm = "FORMATTED";
00271         o__1.oblnk = 0;
00272         ierr = f_open(&o__1);
00273         if (ierr != 0) {
00274             goto L1030;
00275         }
00276     }
00277 /* ..................................................................... 
00278 */
00279 L1050:
00280     n_cstop__ = 0;
00281     s_wsfe(&io___28);
00282     e_wsfe();
00283     i__1 = s_rsfe(&io___29);
00284     if (i__1 != 0) {
00285         goto L1090;
00286     }
00287     i__1 = do_fio(&c__1, c_expr__, 666L);
00288     if (i__1 != 0) {
00289         goto L1090;
00290     }
00291     i__1 = e_rsfe();
00292     if (i__1 != 0) {
00293         goto L1090;
00294     }
00295     if (s_cmp(c_expr__, " ", 666L, 1L) == 0 || s_cmp(c_expr__, "1", 666L, 1L) 
00296             == 0) {
00297         goto L1090;
00298     }
00299     parser_(c_expr__, &c_true, &n_cstop__, c_cstop__, 666L, 8L);
00300     if (n_cstop__ <= 0) {
00301         goto L1050;
00302     }
00303 /* ..................................................................... 
00304 */
00305 L1090:
00306     irow = 0;
00307 L1100:
00308     ++irow;
00309     r8val[25] = (doublereal) irow;
00310     if (ncol > 0) {
00311         i__1 = s_rsle(&io___32);
00312         if (i__1 != 0) {
00313             goto L9000;
00314         }
00315         i__2 = ncol;
00316         for (i__ = 1; i__ <= i__2; ++i__) {
00317             i__1 = do_lio(&c__5, &c__1, (char *)&r8val[i__ - 1], (ftnlen)
00318                     sizeof(doublereal));
00319             if (i__1 != 0) {
00320                 goto L9000;
00321             }
00322         }
00323         i__1 = e_rsle();
00324         if (i__1 != 0) {
00325             goto L9000;
00326         }
00327     }
00328 
00329     i__1 = nout;
00330     for (i__ = 1; i__ <= i__1; ++i__) {
00331         rout[i__ - 1] = pareval_(&num_code__[i__ - 1], c_code__ + (i__ * 200 
00332                 - 200 << 3), r8val, 8L);
00333 /* L1200: */
00334     }
00335     if (n_cstop__ > 0) {
00336         r_cstop__ = pareval_(&n_cstop__, c_cstop__, r8val, 8L);
00337         if (r_cstop__ < 0.) {
00338             goto L9000;
00339         }
00340     }
00341 
00342     if (lstout) {
00343         s_wsfe(&io___35);
00344         i__1 = nout;
00345         for (i__ = 1; i__ <= i__1; ++i__) {
00346             do_fio(&c__1, (char *)&rout[i__ - 1], (ftnlen)sizeof(doublereal));
00347         }
00348         e_wsfe();
00349     } else {
00350         s_wsfe(&io___36);
00351         i__1 = nout;
00352         for (i__ = 1; i__ <= i__1; ++i__) {
00353             do_fio(&c__1, (char *)&rout[i__ - 1], (ftnlen)sizeof(doublereal));
00354         }
00355         e_wsfe();
00356     }
00357 
00358     if (ncol > 0 || irow < nrow) {
00359         goto L1100;
00360     }
00361 /* .......................................................................
00362  */
00363 L9000:
00364     return 0;
00365 } /* MAIN__ */