1 /* -- translated by f2c (version 20100827).
2 You must link the resulting object file with libf2c:
3 on Microsoft Windows system, link with libf2c.lib;
4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5 or, if you install libf2c.a in a standard place, with -lf2c -lm
6 -- in that order, at the end of the command line, as in
7 cc *.o -lf2c -lm
8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
9
10 http://www.netlib.org/f2c/libf2c.zip
11 */
12
13 #include "libtinyf2c.h"
14
15 /* Table of constant values */
16
17 static integer c__3 = 3;
18 static integer c__1 = 1;
19
20 /* ----------------------------------------------------------------------- */
21 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
22 /* ----------------------------------------------------------------------- */
MAIN__(void)23 /* Main program */ int MAIN__(void)
24 {
25 /* System generated locals */
26 address a__1[3];
27 integer i__1[3];
28 char ch__1[42];
29
30 /* Builtin functions */
31 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
32 integer s_wsfe(cilist *);
33 /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
34 integer do_fio(integer *, char *, ftnlen), e_wsfe(void);
35
36 /* Local variables */
37 static integer nl;
38 extern integer lenc_(char *, ftnlen);
39 static char ceval[40], cename[20];
40 extern /* Subroutine */ int osgenv_(char *, char *, ftnlen, ftnlen);
41
42 /* Fortran I/O blocks */
43 static cilist io___3 = { 0, 6, 0, "(A)", 0 };
44 static cilist io___5 = { 0, 6, 0, "(TR1,3A)", 0 };
45
46
47 s_copy(cename, "HOME", (ftnlen)20, (ftnlen)4);
48 nl = lenc_(cename, (ftnlen)20);
49 s_wsfe(&io___3);
50 /* Writing concatenation */
51 i__1[0] = 14, a__1[0] = " CALL OSGENV('";
52 i__1[1] = nl, a__1[1] = cename;
53 i__1[2] = 8, a__1[2] = "',CEVAL)";
54 s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)42);
55 do_fio(&c__1, ch__1, nl + 22);
56 e_wsfe();
57 osgenv_(cename, ceval, (ftnlen)20, (ftnlen)40);
58 s_wsfe(&io___5);
59 do_fio(&c__1, cename, nl);
60 do_fio(&c__1, " = ", (ftnlen)3);
61 do_fio(&c__1, ceval, lenc_(ceval, (ftnlen)40));
62 e_wsfe();
63 return 0;
64 } /* MAIN__ */
65
oslb01_()66 /* Main program alias */ int oslb01_ () { MAIN__ (); return 0; }
67