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__9 = 9;
18 static integer c__1 = 1;
19 static integer c__3 = 3;
20 static real c_b8 = .05f;
21 static real c_b9 = .95f;
22 static integer c__2 = 2;
23 static logical c_true = TRUE_;
24 static real c_b16 = .5f;
25 static integer c__152 = 152;
26 static integer c__153 = 153;
27 static integer c__154 = 154;
28 static integer c__155 = 155;
29 static integer c__156 = 156;
30 static integer c__157 = 157;
31 static integer c__158 = 158;
32 static integer c__159 = 159;
33 static integer c__160 = 160;
34 static integer c__161 = 161;
35 static integer c__10 = 10;
36 static integer c__130 = 130;
37 static integer c__131 = 131;
38 static integer c__135 = 135;
39 static integer c__138 = 138;
40 static integer c__141 = 141;
41 static integer c__143 = 143;
42 static integer c__145 = 145;
43 static integer c__148 = 148;
44 static integer c__150 = 150;
45 static integer c__151 = 151;
46 static integer c__189 = 189;
47 static integer c__190 = 190;
48 static integer c__191 = 191;
49 static integer c__192 = 192;
50 static integer c__193 = 193;
51 static integer c__210 = 210;
52 static integer c__211 = 211;
53 static integer c__212 = 212;
54 static integer c__217 = 217;
55 static integer c__218 = 218;
56
57 /* ----------------------------------------------------------------------- */
58 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
59 /* ----------------------------------------------------------------------- */
MAIN__(void)60 /* Main program */ int MAIN__(void)
61 {
62 /* System generated locals */
63 address a__1[10];
64 integer i__1[10];
65 char ch__1[1], ch__2[1], ch__3[1], ch__4[1], ch__5[1], ch__6[1], ch__7[1],
66 ch__8[1], ch__9[1], ch__10[1];
67
68 /* Builtin functions */
69 integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
70 e_wsle(void), s_rsle(cilist *), e_rsle(void);
71 /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
72
73 /* Local variables */
74 static integer i__;
75 static real y[9], x1, x2, xc;
76 static integer iws;
77 extern /* Character */ VOID csgi_(char *, ftnlen, integer *);
78 extern /* Subroutine */ int sgcls_(void), sgfrm_(void), sgopn_(integer *),
79 sglnv_(real *, real *, real *, real *), sgtxv_(real *, real *,
80 char *, ftnlen);
81 static char greek1[10], greek2[10];
82 extern /* Subroutine */ int sgiset_(char *, integer *, ftnlen), sgslni_(
83 integer *), sglset_(char *, logical *, ftnlen);
84 static char symbol[10];
85 extern /* Subroutine */ int sgrset_(char *, real *, ftnlen), sgpwsn_(void)
86 , sgstxi_(integer *), sgstxs_(real *);
87
88 /* Fortran I/O blocks */
89 static cilist io___1 = { 0, 6, 0, 0, 0 };
90 static cilist io___2 = { 0, 5, 0, 0, 0 };
91
92
93 s_wsle(&io___1);
94 do_lio(&c__9, &c__1, " WORKSTATION ID (I) ? ;", (ftnlen)24);
95 e_wsle();
96 sgpwsn_();
97 s_rsle(&io___2);
98 do_lio(&c__3, &c__1, (char *)&iws, (ftnlen)sizeof(integer));
99 e_rsle();
100 sgopn_(&iws);
101 sgfrm_();
102 x1 = .1f;
103 x2 = .9f;
104 xc = .5f;
105 sgslni_(&c__1);
106 for (i__ = 1; i__ <= 9; ++i__) {
107 y[i__ - 1] = (10 - i__) * .1f;
108 sglnv_(&x1, &y[i__ - 1], &x2, &y[i__ - 1]);
109 /* L10: */
110 }
111 sglnv_(&xc, &c_b8, &xc, &c_b9);
112 /* ----------------------- SUPER/SUB SCRIPT ------------------------------ */
113 sgtxv_(&xc, y, "SGTXV|SUP\"RST_SUB\"", (ftnlen)18);
114 sgstxi_(&c__2);
115 sglset_("LCNTL", &c_true, (ftnlen)5);
116 /* <-- */
117 sgtxv_(&xc, &y[1], "SGTXV|SUP\"RST_SUB\"", (ftnlen)18);
118 sgrset_("SHIFT", &c_b16, (ftnlen)5);
119 /* <-- */
120 sgrset_("SMALL", &c_b16, (ftnlen)5);
121 /* <-- */
122 sgtxv_(&xc, &y[2], "SGTXV|SUP\"RST_SUB\"", (ftnlen)18);
123 /* ------------------------ FONT SELECTION ------------------------------- */
124 sgstxi_(&c__1);
125 sgstxs_(&c_b8);
126 sgtxv_(&xc, &y[3], "ABCDEFG abcdefg", (ftnlen)15);
127 sgiset_("IFONT", &c__2, (ftnlen)5);
128 /* <-- */
129 sgtxv_(&xc, &y[4], "ABCDEFG abcdefg", (ftnlen)15);
130 sgstxi_(&c__3);
131 sgtxv_(&xc, &y[5], "ABCDEFG abcdefg", (ftnlen)15);
132 /* ------------------------- GREEK LETTERS ------------------------------- */
133 /* Writing concatenation */
134 csgi_(ch__1, (ftnlen)1, &c__152);
135 i__1[0] = 1, a__1[0] = ch__1;
136 csgi_(ch__2, (ftnlen)1, &c__153);
137 i__1[1] = 1, a__1[1] = ch__2;
138 csgi_(ch__3, (ftnlen)1, &c__154);
139 i__1[2] = 1, a__1[2] = ch__3;
140 csgi_(ch__4, (ftnlen)1, &c__155);
141 i__1[3] = 1, a__1[3] = ch__4;
142 csgi_(ch__5, (ftnlen)1, &c__156);
143 i__1[4] = 1, a__1[4] = ch__5;
144 csgi_(ch__6, (ftnlen)1, &c__157);
145 i__1[5] = 1, a__1[5] = ch__6;
146 csgi_(ch__7, (ftnlen)1, &c__158);
147 i__1[6] = 1, a__1[6] = ch__7;
148 csgi_(ch__8, (ftnlen)1, &c__159);
149 i__1[7] = 1, a__1[7] = ch__8;
150 csgi_(ch__9, (ftnlen)1, &c__160);
151 i__1[8] = 1, a__1[8] = ch__9;
152 csgi_(ch__10, (ftnlen)1, &c__161);
153 i__1[9] = 1, a__1[9] = ch__10;
154 s_cat(greek1, a__1, i__1, &c__10, (ftnlen)10);
155 /* Writing concatenation */
156 csgi_(ch__1, (ftnlen)1, &c__130);
157 i__1[0] = 1, a__1[0] = ch__1;
158 csgi_(ch__2, (ftnlen)1, &c__131);
159 i__1[1] = 1, a__1[1] = ch__2;
160 csgi_(ch__3, (ftnlen)1, &c__135);
161 i__1[2] = 1, a__1[2] = ch__3;
162 csgi_(ch__4, (ftnlen)1, &c__138);
163 i__1[3] = 1, a__1[3] = ch__4;
164 csgi_(ch__5, (ftnlen)1, &c__141);
165 i__1[4] = 1, a__1[4] = ch__5;
166 csgi_(ch__6, (ftnlen)1, &c__143);
167 i__1[5] = 1, a__1[5] = ch__6;
168 csgi_(ch__7, (ftnlen)1, &c__145);
169 i__1[6] = 1, a__1[6] = ch__7;
170 csgi_(ch__8, (ftnlen)1, &c__148);
171 i__1[7] = 1, a__1[7] = ch__8;
172 csgi_(ch__9, (ftnlen)1, &c__150);
173 i__1[8] = 1, a__1[8] = ch__9;
174 csgi_(ch__10, (ftnlen)1, &c__151);
175 i__1[9] = 1, a__1[9] = ch__10;
176 s_cat(greek2, a__1, i__1, &c__10, (ftnlen)10);
177 sgtxv_(&xc, &y[6], greek1, (ftnlen)10);
178 sgtxv_(&xc, &y[7], greek2, (ftnlen)10);
179 /* ----------------------------- SYMBOLS --------------------------------- */
180 /* Writing concatenation */
181 csgi_(ch__1, (ftnlen)1, &c__189);
182 i__1[0] = 1, a__1[0] = ch__1;
183 csgi_(ch__2, (ftnlen)1, &c__190);
184 i__1[1] = 1, a__1[1] = ch__2;
185 csgi_(ch__3, (ftnlen)1, &c__191);
186 i__1[2] = 1, a__1[2] = ch__3;
187 csgi_(ch__4, (ftnlen)1, &c__192);
188 i__1[3] = 1, a__1[3] = ch__4;
189 csgi_(ch__5, (ftnlen)1, &c__193);
190 i__1[4] = 1, a__1[4] = ch__5;
191 csgi_(ch__6, (ftnlen)1, &c__210);
192 i__1[5] = 1, a__1[5] = ch__6;
193 csgi_(ch__7, (ftnlen)1, &c__211);
194 i__1[6] = 1, a__1[6] = ch__7;
195 csgi_(ch__8, (ftnlen)1, &c__212);
196 i__1[7] = 1, a__1[7] = ch__8;
197 csgi_(ch__9, (ftnlen)1, &c__217);
198 i__1[8] = 1, a__1[8] = ch__9;
199 csgi_(ch__10, (ftnlen)1, &c__218);
200 i__1[9] = 1, a__1[9] = ch__10;
201 s_cat(symbol, a__1, i__1, &c__10, (ftnlen)10);
202 sgtxv_(&xc, &y[8], symbol, (ftnlen)10);
203 sgcls_();
204 return 0;
205 } /* MAIN__ */
206
sgpk07_()207 /* Main program alias */ int sgpk07_ () { MAIN__ (); return 0; }
208