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__100 = 100;
18 static integer c__1 = 1;
19 static integer c__65535 = 65535;
20 static integer c__0 = 0;
21 static integer c__56797 = 56797;
22 static integer c__41120 = 41120;
23 static integer c__32896 = 32896;
24 static integer c__49344 = 49344;
25 static integer c__52171 = 52171;
26
27 /* ----------------------------------------------------------------------- */
28 /* PROGRAM FOR GENERATING COLORMAP */
29
30 /* WRITTEN BY K. ISHIOKA, MODIFIED BY M. SHIOTANI (94/05/07) */
31
32 /* ----------------------------------------------------------------------- */
33 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
34 /* ----------------------------------------------------------------------- */
MAIN__(void)35 /* Main program */ int MAIN__(void)
36 {
37 /* Format strings */
38 static char fmt_100[] = "(i3,a15)";
39 static char fmt_200[] = "(3i6,a6)";
40
41 /* Builtin functions */
42 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
43 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
44 s_wsfi(icilist *), e_wsfi(void);
45 /* Subroutine */ int s_stop(char *, ftnlen);
46
47 /* Local variables */
48 static integer i__, ib, ig, ir;
49 static char ccolor[6];
50
51 /* Fortran I/O blocks */
52 static cilist io___2 = { 0, 6, 0, fmt_100, 0 };
53 static cilist io___3 = { 0, 6, 0, fmt_200, 0 };
54 static cilist io___4 = { 0, 6, 0, fmt_200, 0 };
55 static cilist io___5 = { 0, 6, 0, fmt_200, 0 };
56 static cilist io___6 = { 0, 6, 0, fmt_200, 0 };
57 static cilist io___7 = { 0, 6, 0, fmt_200, 0 };
58 static cilist io___8 = { 0, 6, 0, fmt_200, 0 };
59 static cilist io___9 = { 0, 6, 0, fmt_200, 0 };
60 static cilist io___10 = { 0, 6, 0, fmt_200, 0 };
61 static cilist io___11 = { 0, 6, 0, fmt_200, 0 };
62 static cilist io___12 = { 0, 6, 0, fmt_200, 0 };
63 static icilist io___14 = { 0, ccolor+4, 0, "(I2)", 2, 1 };
64 static cilist io___18 = { 0, 6, 0, fmt_200, 0 };
65 static cilist io___19 = { 0, 6, 0, fmt_200, 0 };
66 static cilist io___20 = { 0, 6, 0, fmt_200, 0 };
67 static cilist io___21 = { 0, 6, 0, fmt_200, 0 };
68 static cilist io___22 = { 0, 6, 0, fmt_200, 0 };
69 static cilist io___23 = { 0, 6, 0, fmt_200, 0 };
70 static cilist io___24 = { 0, 6, 0, fmt_200, 0 };
71
72
73 s_copy(ccolor, " : C**", (ftnlen)6, (ftnlen)6);
74 /* L100: */
75 /* L200: */
76 s_wsfe(&io___2);
77 do_fio(&c__1, (char *)&c__100, (ftnlen)sizeof(integer));
78 do_fio(&c__1, ": NO._OF_COLORS", (ftnlen)15);
79 e_wsfe();
80 s_wsfe(&io___3);
81 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
82 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
83 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
84 do_fio(&c__1, " : C00", (ftnlen)6);
85 e_wsfe();
86 s_wsfe(&io___4);
87 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
88 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
89 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
90 do_fio(&c__1, " : C01", (ftnlen)6);
91 e_wsfe();
92 s_wsfe(&io___5);
93 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
94 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
95 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
96 do_fio(&c__1, " : C02", (ftnlen)6);
97 e_wsfe();
98 s_wsfe(&io___6);
99 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
100 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
101 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
102 do_fio(&c__1, " : C03", (ftnlen)6);
103 e_wsfe();
104 s_wsfe(&io___7);
105 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
106 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
107 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
108 do_fio(&c__1, " : C04", (ftnlen)6);
109 e_wsfe();
110 s_wsfe(&io___8);
111 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
112 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
113 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
114 do_fio(&c__1, " : C05", (ftnlen)6);
115 e_wsfe();
116 s_wsfe(&io___9);
117 do_fio(&c__1, (char *)&c__56797, (ftnlen)sizeof(integer));
118 do_fio(&c__1, (char *)&c__41120, (ftnlen)sizeof(integer));
119 do_fio(&c__1, (char *)&c__56797, (ftnlen)sizeof(integer));
120 do_fio(&c__1, " : C06", (ftnlen)6);
121 e_wsfe();
122 s_wsfe(&io___10);
123 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
124 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
125 do_fio(&c__1, (char *)&c__32896, (ftnlen)sizeof(integer));
126 do_fio(&c__1, " : C07", (ftnlen)6);
127 e_wsfe();
128 s_wsfe(&io___11);
129 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
130 do_fio(&c__1, (char *)&c__49344, (ftnlen)sizeof(integer));
131 do_fio(&c__1, (char *)&c__52171, (ftnlen)sizeof(integer));
132 do_fio(&c__1, " : C08", (ftnlen)6);
133 e_wsfe();
134 s_wsfe(&io___12);
135 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
136 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
137 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
138 do_fio(&c__1, " : C09", (ftnlen)6);
139 e_wsfe();
140 for (i__ = 10; i__ <= 99; ++i__) {
141 s_wsfi(&io___14);
142 do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
143 e_wsfi();
144 if (i__ <= 20) {
145 ir = (20 - i__) * 65535 / 10;
146 ig = 0;
147 ib = 43690;
148 s_wsfe(&io___18);
149 do_fio(&c__1, (char *)&ir, (ftnlen)sizeof(integer));
150 do_fio(&c__1, (char *)&ig, (ftnlen)sizeof(integer));
151 do_fio(&c__1, (char *)&ib, (ftnlen)sizeof(integer));
152 do_fio(&c__1, ccolor, (ftnlen)6);
153 e_wsfe();
154 } else if (i__ <= 25) {
155 ir = 0;
156 ig = 0;
157 ib = (i__ - 10) * 4369;
158 s_wsfe(&io___19);
159 do_fio(&c__1, (char *)&ir, (ftnlen)sizeof(integer));
160 do_fio(&c__1, (char *)&ig, (ftnlen)sizeof(integer));
161 do_fio(&c__1, (char *)&ib, (ftnlen)sizeof(integer));
162 do_fio(&c__1, ccolor, (ftnlen)6);
163 e_wsfe();
164 } else if (i__ <= 40) {
165 ir = 0;
166 ig = (i__ - 25) * 4369;
167 ib = 65535;
168 s_wsfe(&io___20);
169 do_fio(&c__1, (char *)&ir, (ftnlen)sizeof(integer));
170 do_fio(&c__1, (char *)&ig, (ftnlen)sizeof(integer));
171 do_fio(&c__1, (char *)&ib, (ftnlen)sizeof(integer));
172 do_fio(&c__1, ccolor, (ftnlen)6);
173 e_wsfe();
174 } else if (i__ <= 55) {
175 ir = 0;
176 ig = 65535;
177 ib = (55 - i__) * 4369;
178 s_wsfe(&io___21);
179 do_fio(&c__1, (char *)&ir, (ftnlen)sizeof(integer));
180 do_fio(&c__1, (char *)&ig, (ftnlen)sizeof(integer));
181 do_fio(&c__1, (char *)&ib, (ftnlen)sizeof(integer));
182 do_fio(&c__1, ccolor, (ftnlen)6);
183 e_wsfe();
184 } else if (i__ <= 70) {
185 ir = (i__ - 55) * 4369;
186 ig = 65535;
187 ib = 0;
188 s_wsfe(&io___22);
189 do_fio(&c__1, (char *)&ir, (ftnlen)sizeof(integer));
190 do_fio(&c__1, (char *)&ig, (ftnlen)sizeof(integer));
191 do_fio(&c__1, (char *)&ib, (ftnlen)sizeof(integer));
192 do_fio(&c__1, ccolor, (ftnlen)6);
193 e_wsfe();
194 } else if (i__ <= 85) {
195 ir = 65535;
196 ig = (85 - i__) * 4369;
197 ib = 0;
198 s_wsfe(&io___23);
199 do_fio(&c__1, (char *)&ir, (ftnlen)sizeof(integer));
200 do_fio(&c__1, (char *)&ig, (ftnlen)sizeof(integer));
201 do_fio(&c__1, (char *)&ib, (ftnlen)sizeof(integer));
202 do_fio(&c__1, ccolor, (ftnlen)6);
203 e_wsfe();
204 } else if (i__ <= 99) {
205 ir = 65535;
206 ig = (i__ - 85) * 4369;
207 ib = (i__ - 85) * 4369;
208 s_wsfe(&io___24);
209 do_fio(&c__1, (char *)&ir, (ftnlen)sizeof(integer));
210 do_fio(&c__1, (char *)&ig, (ftnlen)sizeof(integer));
211 do_fio(&c__1, (char *)&ib, (ftnlen)sizeof(integer));
212 do_fio(&c__1, ccolor, (ftnlen)6);
213 e_wsfe();
214 }
215 /* L10: */
216 }
217 s_stop("", (ftnlen)0);
218 return 0;
219 } /* MAIN__ */
220
cmap02_()221 /* Main program alias */ int cmap02_ () { MAIN__ (); return 0; }
222