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
71
72 s_copy(ccolor, " : C**", (ftnlen)6, (ftnlen)6);
73 /* L100: */
74 /* L200: */
75 s_wsfe(&io___2);
76 do_fio(&c__1, (char *)&c__100, (ftnlen)sizeof(integer));
77 do_fio(&c__1, ": NO._OF_COLORS", (ftnlen)15);
78 e_wsfe();
79 s_wsfe(&io___3);
80 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
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, " : C00", (ftnlen)6);
84 e_wsfe();
85 s_wsfe(&io___4);
86 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
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, " : C01", (ftnlen)6);
90 e_wsfe();
91 s_wsfe(&io___5);
92 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
93 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
94 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
95 do_fio(&c__1, " : C02", (ftnlen)6);
96 e_wsfe();
97 s_wsfe(&io___6);
98 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
99 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
100 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
101 do_fio(&c__1, " : C03", (ftnlen)6);
102 e_wsfe();
103 s_wsfe(&io___7);
104 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
105 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
106 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
107 do_fio(&c__1, " : C04", (ftnlen)6);
108 e_wsfe();
109 s_wsfe(&io___8);
110 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
111 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
112 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
113 do_fio(&c__1, " : C05", (ftnlen)6);
114 e_wsfe();
115 s_wsfe(&io___9);
116 do_fio(&c__1, (char *)&c__56797, (ftnlen)sizeof(integer));
117 do_fio(&c__1, (char *)&c__41120, (ftnlen)sizeof(integer));
118 do_fio(&c__1, (char *)&c__56797, (ftnlen)sizeof(integer));
119 do_fio(&c__1, " : C06", (ftnlen)6);
120 e_wsfe();
121 s_wsfe(&io___10);
122 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
123 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
124 do_fio(&c__1, (char *)&c__32896, (ftnlen)sizeof(integer));
125 do_fio(&c__1, " : C07", (ftnlen)6);
126 e_wsfe();
127 s_wsfe(&io___11);
128 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
129 do_fio(&c__1, (char *)&c__49344, (ftnlen)sizeof(integer));
130 do_fio(&c__1, (char *)&c__52171, (ftnlen)sizeof(integer));
131 do_fio(&c__1, " : C08", (ftnlen)6);
132 e_wsfe();
133 s_wsfe(&io___12);
134 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
135 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
136 do_fio(&c__1, (char *)&c__65535, (ftnlen)sizeof(integer));
137 do_fio(&c__1, " : C09", (ftnlen)6);
138 e_wsfe();
139 for (i__ = 10; i__ <= 99; ++i__) {
140 s_wsfi(&io___14);
141 do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
142 e_wsfi();
143 if (i__ <= 25) {
144 ir = 0;
145 ig = 0;
146 ib = (i__ - 10) * 4369;
147 s_wsfe(&io___18);
148 do_fio(&c__1, (char *)&ir, (ftnlen)sizeof(integer));
149 do_fio(&c__1, (char *)&ig, (ftnlen)sizeof(integer));
150 do_fio(&c__1, (char *)&ib, (ftnlen)sizeof(integer));
151 do_fio(&c__1, ccolor, (ftnlen)6);
152 e_wsfe();
153 } else if (i__ <= 40) {
154 ir = 0;
155 ig = (i__ - 25) * 4369;
156 ib = 65535;
157 s_wsfe(&io___19);
158 do_fio(&c__1, (char *)&ir, (ftnlen)sizeof(integer));
159 do_fio(&c__1, (char *)&ig, (ftnlen)sizeof(integer));
160 do_fio(&c__1, (char *)&ib, (ftnlen)sizeof(integer));
161 do_fio(&c__1, ccolor, (ftnlen)6);
162 e_wsfe();
163 } else if (i__ <= 55) {
164 ir = 0;
165 ig = 65535;
166 ib = (55 - i__) * 4369;
167 s_wsfe(&io___20);
168 do_fio(&c__1, (char *)&ir, (ftnlen)sizeof(integer));
169 do_fio(&c__1, (char *)&ig, (ftnlen)sizeof(integer));
170 do_fio(&c__1, (char *)&ib, (ftnlen)sizeof(integer));
171 do_fio(&c__1, ccolor, (ftnlen)6);
172 e_wsfe();
173 } else if (i__ <= 70) {
174 ir = (i__ - 55) * 4369;
175 ig = 65535;
176 ib = 0;
177 s_wsfe(&io___21);
178 do_fio(&c__1, (char *)&ir, (ftnlen)sizeof(integer));
179 do_fio(&c__1, (char *)&ig, (ftnlen)sizeof(integer));
180 do_fio(&c__1, (char *)&ib, (ftnlen)sizeof(integer));
181 do_fio(&c__1, ccolor, (ftnlen)6);
182 e_wsfe();
183 } else if (i__ <= 85) {
184 ir = 65535;
185 ig = (85 - i__) * 4369;
186 ib = 0;
187 s_wsfe(&io___22);
188 do_fio(&c__1, (char *)&ir, (ftnlen)sizeof(integer));
189 do_fio(&c__1, (char *)&ig, (ftnlen)sizeof(integer));
190 do_fio(&c__1, (char *)&ib, (ftnlen)sizeof(integer));
191 do_fio(&c__1, ccolor, (ftnlen)6);
192 e_wsfe();
193 } else if (i__ <= 99) {
194 ir = 65535;
195 ig = (i__ - 85) * 4369;
196 ib = (i__ - 85) * 4369;
197 s_wsfe(&io___23);
198 do_fio(&c__1, (char *)&ir, (ftnlen)sizeof(integer));
199 do_fio(&c__1, (char *)&ig, (ftnlen)sizeof(integer));
200 do_fio(&c__1, (char *)&ib, (ftnlen)sizeof(integer));
201 do_fio(&c__1, ccolor, (ftnlen)6);
202 e_wsfe();
203 }
204 /* L10: */
205 }
206 s_stop("", (ftnlen)0);
207 return 0;
208 } /* MAIN__ */
209
cmap01_()210 /* Main program alias */ int cmap01_ () { MAIN__ (); return 0; }
211