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_n1 = -1;
18 static integer c__9 = 9;
19 static integer c__1 = 1;
20 static integer c__3 = 3;
21 static integer c__201 = 201;
22 static integer c__2 = 2;
23
24 /* ----------------------------------------------------------------------- */
25 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
26 /* ----------------------------------------------------------------------- */
MAIN__(void)27 /* Main program */ int MAIN__(void)
28 {
29 /* Builtin functions */
30 integer pow_ii(integer *, integer *);
31 double cos(doublereal);
32 integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
33 e_wsle(void), s_rsle(cilist *), e_rsle(void);
34
35 /* Local variables */
36 static real a[5];
37 static integer i__, n;
38 static real t, x[201], y0[201], y1[201], y2[201];
39 static integer ii;
40 static real pi;
41 static integer iws;
42 extern /* Subroutine */ int grcls_(void), grfrm_(void), gropn_(integer *),
43 uulin_(integer *, real *, real *), grstrf_(void), usdaxs_(void),
44 uspfit_(void), uuslni_(integer *), sgpwsn_(void), uuslnt_(integer
45 *), usspnt_(integer *, real *, real *), ussttl_(char *, char *,
46 char *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
47
48 /* Fortran I/O blocks */
49 static cilist io___11 = { 0, 6, 0, 0, 0 };
50 static cilist io___12 = { 0, 5, 0, 0, 0 };
51
52
53 pi = 3.14159f;
54 for (i__ = 1; i__ <= 5; ++i__) {
55 ii = (i__ << 1) - 1;
56 a[i__ - 1] = pow_ii(&c_n1, &i__) * 2.f / (ii * pi);
57 /* L10: */
58 }
59 for (n = 1; n <= 201; ++n) {
60 x[n - 1] = (n - 1) * 1.f / 200;
61 t = pi * 2.f * x[n - 1];
62 if (t < pi / 2.f || t >= pi * 3.f / 2.f) {
63 y0[n - 1] = 0.f;
64 } else {
65 y0[n - 1] = 1.f;
66 }
67 y1[n - 1] = a[0] * cos(t) + .5f;
68 y2[n - 1] = .5f;
69 for (i__ = 1; i__ <= 5; ++i__) {
70 ii = (i__ << 1) - 1;
71 y2[n - 1] += a[i__ - 1] * cos(ii * t);
72 /* L30: */
73 }
74 /* L20: */
75 }
76 s_wsle(&io___11);
77 do_lio(&c__9, &c__1, " WORKSTATION ID (I) ? ;", (ftnlen)24);
78 e_wsle();
79 sgpwsn_();
80 s_rsle(&io___12);
81 do_lio(&c__3, &c__1, (char *)&iws, (ftnlen)sizeof(integer));
82 e_rsle();
83 gropn_(&iws);
84 grfrm_();
85 usspnt_(&c__201, x, y0);
86 usspnt_(&c__201, x, y1);
87 usspnt_(&c__201, x, y2);
88 uspfit_();
89 grstrf_();
90 ussttl_("FREQUENCY", "/DAY", "RESPONSE", " ", (ftnlen)9, (ftnlen)4, (
91 ftnlen)8, (ftnlen)1);
92 usdaxs_();
93 uulin_(&c__201, x, y0);
94 uuslnt_(&c__2);
95 uuslni_(&c__3);
96 uulin_(&c__201, x, y1);
97 uuslnt_(&c__3);
98 uulin_(&c__201, x, y2);
99 grcls_();
100 return 0;
101 } /* MAIN__ */
102
uspac2_()103 /* Main program alias */ int uspac2_ () { MAIN__ (); return 0; }
104