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 logical c_true = TRUE_;
21 static real c_b11 = -1.f;
22 static real c_b12 = 1.f;
23 static real c_b15 = 0.f;
24 static real c_b16 = .5f;
25 static integer c__101 = 101;
26 static integer c__6 = 6;
27 static integer c__201 = 201;
28 static integer c__61 = 61;
29 static integer c__601 = 601;
30
31 /* ----------------------------------------------------------------------- */
32 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
33 /* ----------------------------------------------------------------------- */
MAIN__(void)34 /* Main program */ int MAIN__(void)
35 {
36 /* Builtin functions */
37 double sin(doublereal), cos(doublereal);
38 integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
39 e_wsle(void), s_rsle(cilist *), e_rsle(void);
40
41 /* Local variables */
42 static real a;
43 static integer i__;
44 static real th;
45 static integer iws;
46 static real upx3[3], upy3[3], upx6[6], upy6[6], upxs[61], upys[61];
47 extern /* Subroutine */ int sgcls_(void), sgfrm_(void), sgopn_(integer *),
48 sgplu_(integer *, real *, real *), sgtnu_(integer *, real *,
49 real *), sglset_(char *, logical *, ftnlen), sgswnd_(real *, real
50 *, real *, real *), sgstrf_(void), sgstnp_(integer *), sgstrn_(
51 integer *), sgpwsn_(void), sgsvpt_(real *, real *, real *, real *)
52 , sgtnzu_(integer *, real *, real *, integer *);
53
54 /* Fortran I/O blocks */
55 static cilist io___10 = { 0, 6, 0, 0, 0 };
56 static cilist io___11 = { 0, 5, 0, 0, 0 };
57
58
59 a = .8f;
60 th = 2.0943933333333331f;
61 for (i__ = 1; i__ <= 3; ++i__) {
62 upx3[i__ - 1] = a * sin(th * i__);
63 upy3[i__ - 1] = a * cos(th * i__);
64 /* L100: */
65 }
66 th = 1.0471966666666666f;
67 for (i__ = 1; i__ <= 6; ++i__) {
68 upx6[i__ - 1] = a * sin(th * i__);
69 upy6[i__ - 1] = a * cos(th * i__);
70 /* L200: */
71 }
72 th = .20943933333333334f;
73 for (i__ = 1; i__ <= 61; ++i__) {
74 upxs[i__ - 1] = a * (i__ - 31) / 30.f;
75 upys[i__ - 1] = a * sin(th * (i__ - 1));
76 /* L300: */
77 }
78 s_wsle(&io___10);
79 do_lio(&c__9, &c__1, " WORKSTATION ID (I) ? ;", (ftnlen)24);
80 e_wsle();
81 sgpwsn_();
82 s_rsle(&io___11);
83 do_lio(&c__3, &c__1, (char *)&iws, (ftnlen)sizeof(integer));
84 e_rsle();
85 sgopn_(&iws);
86 sglset_("LSOFTF", &c_true, (ftnlen)6);
87 /* <-- */
88 sgfrm_();
89 sgswnd_(&c_b11, &c_b12, &c_b11, &c_b12);
90 sgsvpt_(&c_b15, &c_b16, &c_b15, &c_b16);
91 sgstrn_(&c__1);
92 sgstrf_();
93 sgplu_(&c__3, upx3, upy3);
94 sgtnu_(&c__3, upx3, upy3);
95 /* <-- 網かけ (左下) */
96 sgsvpt_(&c_b15, &c_b16, &c_b16, &c_b12);
97 sgstrf_();
98 sgstnp_(&c__101);
99 sgtnu_(&c__6, upx6, upy6);
100 /* <-- 横線 (左上) */
101 sgsvpt_(&c_b16, &c_b12, &c_b15, &c_b16);
102 sgstrf_();
103 sgtnzu_(&c__6, upx6, upy6, &c__201);
104 /* <-- 斜線 (右下) */
105 sgsvpt_(&c_b16, &c_b12, &c_b16, &c_b12);
106 sgstrf_();
107 sgtnzu_(&c__61, upxs, upys, &c__601);
108 /* <-- 横線 (右上) */
109 sgcls_();
110 return 0;
111 } /* MAIN__ */
112
sgpk08_()113 /* Main program alias */ int sgpk08_ () { MAIN__ (); return 0; }
114