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__2 = 2;
18 static integer c__1 = 1;
19
20 /* ----------------------------------------------------------------------- */
uicrgb_0_(int n__,real * val,real * cmask,integer * irgb,real * zmin,real * zmax,real * clrlvl,integer * icolor,integer * n,char * cdsn,real * shdlvl,real * shade,ftnlen cdsn_len)21 /* Subroutine */ int uicrgb_0_(int n__, real *val, real *cmask, integer *irgb,
22 real *zmin, real *zmax, real *clrlvl, integer *icolor, integer *n,
23 char *cdsn, real *shdlvl, real *shade, ftnlen cdsn_len)
24 {
25 /* Initialized data */
26
27 static integer nlev = 7;
28 static real rs0[256] = { 0.f,.5f,.5f,1.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
29 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
30 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
31 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
32 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
33 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
34 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
35 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
36 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
37 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
38 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
39 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
40 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
41 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
42 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
43 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
44 0.f,0.f,0.f,0.f };
45 static integer nshade = 4;
46 static logical lcset = FALSE_;
47 static logical lsset = FALSE_;
48 static integer ir[256] = { 255,0,0,0,255,255,255,0,0,0,0,0,0,0,0,0,0,0,0,
49 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
50 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
51 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
52 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
53 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
54 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
55 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
56 0,0,0,0,0,0 };
57 static integer ig[256] = { 0,0,255,255,255,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
58 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
59 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
60 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
61 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
62 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
63 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
64 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
65 0,0,0,0,0 };
66 static integer ib[256] = { 255,255,255,0,0,0,255,0,0,0,0,0,0,0,0,0,0,0,0,
67 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
68 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
69 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
70 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
71 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
72 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
73 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
74 0,0,0,0,0,0 };
75 static real rc0[256] = { 0.f,.1667f,.3333f,.5f,.6667f,.8333f,1.f,0.f,0.f,
76 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
77 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
78 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
79 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
80 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
81 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
82 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
83 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
84 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
85 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
86 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
87 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
88 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
89 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
90 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
91 0.f,0.f,0.f,0.f,0.f,0.f,0.f };
92 static real sd[256] = { -.2f,-.2f,.2f,.2f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
93 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
94 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
95 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
96 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
97 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
98 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
99 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
100 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
101 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
102 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
103 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
104 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
105 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
106 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
107 0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,
108 0.f,0.f,0.f,0.f };
109
110 /* System generated locals */
111 address a__1[2];
112 integer i__1, i__2[2];
113 real r__1, r__2;
114 olist o__1;
115 cllist cl__1;
116
117 /* Builtin functions */
118 double r_mod(real *, real *);
119 integer s_cmp(char *, char *, ftnlen, ftnlen);
120 /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
121 integer f_open(olist *), s_rsfe(cilist *), do_fio(integer *, char *,
122 ftnlen), e_rsfe(void), f_clos(cllist *);
123
124 /* Local variables */
125 static integer i__;
126 static real x0, x1, x2, cc;
127 static integer jb, kb, jg, kg;
128 static real rc[256], vc;
129 static integer jr, kr, iu, nn;
130 static real vm, rs[256];
131 extern integer lenc_(char *, ftnlen);
132 static char cmsg[80];
133 static integer iclr;
134 static real rmin, rmax;
135 static integer iost;
136 static real range, rcmin, rcmax;
137 static char cdsnx[80];
138 static real rsmin, rsmax;
139 static logical lshade;
140 extern /* Subroutine */ int uifpac_(integer *, integer *, integer *,
141 integer *), uiipac_(integer *, integer *, integer *, integer *);
142 static logical lcycle;
143 extern /* Subroutine */ int msgdmp_(char *, char *, char *, ftnlen,
144 ftnlen, ftnlen), uilget_(char *, logical *, ftnlen), uiqfnm_(char
145 *, char *, ftnlen, ftnlen);
146 extern integer iufopn_(void);
147 static real xlevel;
148
149 /* Fortran I/O blocks */
150 static cilist io___36 = { 0, 0, 0, "(I3)", 0 };
151 static cilist io___39 = { 1, 0, 1, "(G6.4, Z8)", 0 };
152 static cilist io___44 = { 0, 0, 0, "(I3)", 0 };
153 static cilist io___45 = { 1, 0, 1, "(F6.4,F8.3)", 0 };
154
155
156 /* Parameter adjustments */
157 if (clrlvl) {
158 --clrlvl;
159 }
160 if (icolor) {
161 --icolor;
162 }
163 if (shdlvl) {
164 --shdlvl;
165 }
166 if (shade) {
167 --shade;
168 }
169
170 /* Function Body */
171 switch(n__) {
172 case 1: goto L_uicini;
173 case 2: goto L_uiscrg;
174 case 3: goto L_uismrg;
175 case 4: goto L_uiscsq;
176 case 5: goto L_uiscfl;
177 case 6: goto L_uismsq;
178 case 7: goto L_uismfl;
179 }
180
181 if (lcycle) {
182 range = rc[nlev - 1] - rc[0];
183 r__2 = *val - rc[0];
184 r__1 = r_mod(&r__2, &range) + range;
185 vc = r_mod(&r__1, &range) + rc[0];
186 } else {
187 vc = *val;
188 }
189 if (vc <= rc[0]) {
190 jr = ir[0];
191 jg = ig[0];
192 jb = ib[0];
193 goto L100;
194 }
195 i__1 = nlev;
196 for (i__ = 2; i__ <= i__1; ++i__) {
197 if (vc <= rc[i__ - 1]) {
198 x0 = rc[i__ - 1] - rc[i__ - 2];
199 x1 = rc[i__ - 1] - vc;
200 x2 = vc - rc[i__ - 2];
201 jr = (x2 * ir[i__ - 1] + x1 * ir[i__ - 2]) / x0;
202 jg = (x2 * ig[i__ - 1] + x1 * ig[i__ - 2]) / x0;
203 jb = (x2 * ib[i__ - 1] + x1 * ib[i__ - 2]) / x0;
204 goto L100;
205 }
206 /* L10: */
207 }
208 jr = ir[nlev - 1];
209 jg = ig[nlev - 1];
210 jb = ib[nlev - 1];
211 L100:
212 if (lshade) {
213 range = rs[nshade - 1] - rs[0];
214 r__2 = *val - rs[0];
215 r__1 = r_mod(&r__2, &range) + range;
216 vm = r_mod(&r__1, &range) + rs[0];
217 i__1 = nshade;
218 for (i__ = 2; i__ <= i__1; ++i__) {
219 if (vm <= rs[i__ - 1]) {
220 x0 = rs[i__ - 1] - rs[i__ - 2];
221 x1 = rs[i__ - 1] - vm;
222 x2 = vm - rs[i__ - 2];
223 cc = (x2 * sd[i__ - 1] + x1 * sd[i__ - 2]) / x0;
224 goto L120;
225 }
226 /* L110: */
227 }
228 L120:
229 ;
230 } else {
231 cc = *cmask;
232 }
233 if (cc > 0.f) {
234 kr = jr + (255 - jr) * cc;
235 kg = jg + (255 - jg) * cc;
236 kb = jb + (255 - jb) * cc;
237 } else {
238 kr = jr * (r__1 = cc + 1.f, abs(r__1));
239 kg = jg * (r__1 = cc + 1.f, abs(r__1));
240 kb = jb * (r__1 = cc + 1.f, abs(r__1));
241 }
242 uifpac_(&kr, &kg, &kb, irgb);
243 return 0;
244 /* ----------------------------------------------------------------------- */
245
246 L_uicini:
247 uilget_("LCYCLE", &lcycle, (ftnlen)6);
248 uilget_("LMASK", &lshade, (ftnlen)5);
249 if (! lcset) {
250 rcmin = *zmin;
251 rcmax = *zmax;
252 }
253 if (! lsset) {
254 rsmin = rcmin;
255 rsmax = rcmin + (rcmax - rcmin) / 10.f;
256 }
257 i__1 = nlev;
258 for (i__ = 1; i__ <= i__1; ++i__) {
259 rc[i__ - 1] = rc0[i__ - 1] * (rcmax - rcmin) + rcmin;
260 /* L200: */
261 }
262 i__1 = nshade;
263 for (i__ = 1; i__ <= i__1; ++i__) {
264 rs[i__ - 1] = rs0[i__ - 1] * (rsmax - rsmin) + rsmin;
265 /* L210: */
266 }
267 return 0;
268 /* ----------------------------------------------------------------------- */
269
270 L_uiscrg:
271 if (*zmin >= *zmax) {
272 msgdmp_("E", "UISCRG", "ZMIN > ZMAX.", (ftnlen)1, (ftnlen)6, (ftnlen)
273 12);
274 }
275 rcmin = *zmin;
276 rcmax = *zmax;
277 lcset = TRUE_;
278 return 0;
279 /* ----------------------------------------------------------------------- */
280
281 L_uismrg:
282 if (*zmin >= *zmax) {
283 msgdmp_("E", "UISMRG", "ZMIN > ZMAX.", (ftnlen)1, (ftnlen)6, (ftnlen)
284 12);
285 }
286 rsmin = *zmin;
287 rsmax = *zmax;
288 lsset = TRUE_;
289 return 0;
290 /* ----------------------------------------------------------------------- */
291
292 L_uiscsq:
293 if (*n > 256) {
294 msgdmp_("M", "UISCSQ", "TOO MANY LEVEL (N).", (ftnlen)1, (ftnlen)6, (
295 ftnlen)19);
296 }
297 nlev = min(*n,256);
298 i__1 = *n;
299 for (i__ = 1; i__ <= i__1; ++i__) {
300 rc0[i__ - 1] = (clrlvl[i__] - clrlvl[1]) / (clrlvl[*n] - clrlvl[1]);
301 uiipac_(&icolor[i__], &ir[i__ - 1], &ig[i__ - 1], &ib[i__ - 1]);
302 /* L20: */
303 }
304 return 0;
305 /* ----------------------------------------------------------------------- */
306
307 L_uiscfl:
308 /* / INQUIRE OUTLINE FILE / */
309 uiqfnm_(cdsn, cdsnx, cdsn_len, (ftnlen)80);
310 if (s_cmp(cdsnx, " ", (ftnlen)80, (ftnlen)1) == 0) {
311 /* Writing concatenation */
312 i__2[0] = 17, a__1[0] = "COLOR MAP FILE = ";
313 i__2[1] = lenc_(cdsn, cdsn_len), a__1[1] = cdsn;
314 s_cat(cmsg, a__1, i__2, &c__2, (ftnlen)80);
315 msgdmp_("M", "UISCFL", cmsg, (ftnlen)1, (ftnlen)6, (ftnlen)80);
316 msgdmp_("E", "UISCFL", "COLOR MAP FILE DOES NOT EXIST.", (ftnlen)1, (
317 ftnlen)6, (ftnlen)30);
318 }
319 /* / OPEN OUTLINE FILE / */
320 iu = iufopn_();
321 o__1.oerr = 0;
322 o__1.ounit = iu;
323 o__1.ofnmlen = 80;
324 o__1.ofnm = cdsnx;
325 o__1.orl = 0;
326 o__1.osta = "OLD";
327 o__1.oacc = 0;
328 o__1.ofm = "FORMATTED";
329 o__1.oblnk = 0;
330 f_open(&o__1);
331 io___36.ciunit = iu;
332 s_rsfe(&io___36);
333 do_fio(&c__1, (char *)&nn, (ftnlen)sizeof(integer));
334 e_rsfe();
335 if (nn > 256) {
336 msgdmp_("M", "UISCFL", "TOO MANY LEVEL.", (ftnlen)1, (ftnlen)6, (
337 ftnlen)15);
338 }
339 nlev = min(nn,256);
340 i__1 = nlev;
341 for (i__ = 1; i__ <= i__1; ++i__) {
342 io___39.ciunit = iu;
343 iost = s_rsfe(&io___39);
344 if (iost != 0) {
345 goto L100001;
346 }
347 iost = do_fio(&c__1, (char *)&xlevel, (ftnlen)sizeof(real));
348 if (iost != 0) {
349 goto L100001;
350 }
351 iost = do_fio(&c__1, (char *)&iclr, (ftnlen)sizeof(integer));
352 if (iost != 0) {
353 goto L100001;
354 }
355 iost = e_rsfe();
356 L100001:
357 if (iost != 0) {
358 msgdmp_("E", "UISCFL", "ERROR IN FILE.", (ftnlen)1, (ftnlen)6, (
359 ftnlen)14);
360 }
361 rc0[i__ - 1] = xlevel;
362 uiipac_(&iclr, &ir[i__ - 1], &ig[i__ - 1], &ib[i__ - 1]);
363 /* L30: */
364 }
365 rmin = rc0[0];
366 rmax = rc0[nlev - 1];
367 i__1 = nlev;
368 for (i__ = 1; i__ <= i__1; ++i__) {
369 rc0[i__ - 1] = (rc0[i__ - 1] - rmin) / (rmax - rmin);
370 /* L40: */
371 }
372 cl__1.cerr = 0;
373 cl__1.cunit = iu;
374 cl__1.csta = 0;
375 f_clos(&cl__1);
376 return 0;
377 /* ----------------------------------------------------------------------- */
378
379 L_uismsq:
380 if (*n > 256) {
381 msgdmp_("M", "UISMSQ", "TOO MANY LEVEL (N).", (ftnlen)1, (ftnlen)6, (
382 ftnlen)19);
383 }
384 nshade = min(*n,256);
385 i__1 = *n;
386 for (i__ = 1; i__ <= i__1; ++i__) {
387 rs0[i__ - 1] = (shdlvl[i__] - shdlvl[1]) / (shdlvl[*n] - shdlvl[1]);
388 sd[i__ - 1] = shade[i__];
389 /* L50: */
390 }
391 return 0;
392 /* ----------------------------------------------------------------------- */
393
394 L_uismfl:
395 /* / INQUIRE OUTLINE FILE / */
396 uiqfnm_(cdsn, cdsnx, cdsn_len, (ftnlen)80);
397 if (s_cmp(cdsnx, " ", (ftnlen)80, (ftnlen)1) == 0) {
398 /* Writing concatenation */
399 i__2[0] = 17, a__1[0] = "COLOR MAP FILE = ";
400 i__2[1] = lenc_(cdsn, cdsn_len), a__1[1] = cdsn;
401 s_cat(cmsg, a__1, i__2, &c__2, (ftnlen)80);
402 msgdmp_("M", "UISMFL", cmsg, (ftnlen)1, (ftnlen)6, (ftnlen)80);
403 msgdmp_("E", "UISMFL", "MASK FILE DOES NOT EXIST.", (ftnlen)1, (
404 ftnlen)6, (ftnlen)25);
405 }
406 /* / OPEN OUTLINE FILE / */
407 iu = iufopn_();
408 o__1.oerr = 0;
409 o__1.ounit = iu;
410 o__1.ofnmlen = 80;
411 o__1.ofnm = cdsnx;
412 o__1.orl = 0;
413 o__1.osta = "OLD";
414 o__1.oacc = 0;
415 o__1.ofm = "FORMATTED";
416 o__1.oblnk = 0;
417 f_open(&o__1);
418 io___44.ciunit = iu;
419 s_rsfe(&io___44);
420 do_fio(&c__1, (char *)&nn, (ftnlen)sizeof(integer));
421 e_rsfe();
422 if (nn > 256) {
423 msgdmp_("M", "UISMFL", "TOO MANY LEVEL.", (ftnlen)1, (ftnlen)6, (
424 ftnlen)15);
425 }
426 nshade = min(nn,256);
427 i__1 = nshade;
428 for (i__ = 1; i__ <= i__1; ++i__) {
429 io___45.ciunit = iu;
430 iost = s_rsfe(&io___45);
431 if (iost != 0) {
432 goto L100002;
433 }
434 iost = do_fio(&c__1, (char *)&rs0[i__ - 1], (ftnlen)sizeof(real));
435 if (iost != 0) {
436 goto L100002;
437 }
438 iost = do_fio(&c__1, (char *)&sd[i__ - 1], (ftnlen)sizeof(real));
439 if (iost != 0) {
440 goto L100002;
441 }
442 iost = e_rsfe();
443 L100002:
444 if (iost != 0) {
445 msgdmp_("E", "UISMFL", "ERROR IN FILE.", (ftnlen)1, (ftnlen)6, (
446 ftnlen)14);
447 }
448 /* L60: */
449 }
450 rmin = rs0[0];
451 rmax = rs0[nshade - 1];
452 i__1 = nshade;
453 for (i__ = 1; i__ <= i__1; ++i__) {
454 rs0[i__ - 1] = (rs0[i__ - 1] - rmin) / (rmax - rmin);
455 /* L70: */
456 }
457 cl__1.cerr = 0;
458 cl__1.cunit = iu;
459 cl__1.csta = 0;
460 f_clos(&cl__1);
461 return 0;
462 } /* uicrgb_ */
463
uicrgb_(real * val,real * cmask,integer * irgb)464 /* Subroutine */ int uicrgb_(real *val, real *cmask, integer *irgb)
465 {
466 return uicrgb_0_(0, val, cmask, irgb, (real *)0, (real *)0, (real *)0, (
467 integer *)0, (integer *)0, (char *)0, (real *)0, (real *)0, (
468 ftnint)0);
469 }
470
uicini_(real * zmin,real * zmax)471 /* Subroutine */ int uicini_(real *zmin, real *zmax)
472 {
473 return uicrgb_0_(1, (real *)0, (real *)0, (integer *)0, zmin, zmax, (real
474 *)0, (integer *)0, (integer *)0, (char *)0, (real *)0, (real *)0,
475 (ftnint)0);
476 }
477
uiscrg_(real * zmin,real * zmax)478 /* Subroutine */ int uiscrg_(real *zmin, real *zmax)
479 {
480 return uicrgb_0_(2, (real *)0, (real *)0, (integer *)0, zmin, zmax, (real
481 *)0, (integer *)0, (integer *)0, (char *)0, (real *)0, (real *)0,
482 (ftnint)0);
483 }
484
uismrg_(real * zmin,real * zmax)485 /* Subroutine */ int uismrg_(real *zmin, real *zmax)
486 {
487 return uicrgb_0_(3, (real *)0, (real *)0, (integer *)0, zmin, zmax, (real
488 *)0, (integer *)0, (integer *)0, (char *)0, (real *)0, (real *)0,
489 (ftnint)0);
490 }
491
uiscsq_(real * clrlvl,integer * icolor,integer * n)492 /* Subroutine */ int uiscsq_(real *clrlvl, integer *icolor, integer *n)
493 {
494 return uicrgb_0_(4, (real *)0, (real *)0, (integer *)0, (real *)0, (real *
495 )0, clrlvl, icolor, n, (char *)0, (real *)0, (real *)0, (ftnint)0)
496 ;
497 }
498
uiscfl_(char * cdsn,ftnlen cdsn_len)499 /* Subroutine */ int uiscfl_(char *cdsn, ftnlen cdsn_len)
500 {
501 return uicrgb_0_(5, (real *)0, (real *)0, (integer *)0, (real *)0, (real *
502 )0, (real *)0, (integer *)0, (integer *)0, cdsn, (real *)0, (real
503 *)0, cdsn_len);
504 }
505
uismsq_(real * shdlvl,real * shade,integer * n)506 /* Subroutine */ int uismsq_(real *shdlvl, real *shade, integer *n)
507 {
508 return uicrgb_0_(6, (real *)0, (real *)0, (integer *)0, (real *)0, (real *
509 )0, (real *)0, (integer *)0, n, (char *)0, shdlvl, shade, (ftnint)
510 0);
511 }
512
uismfl_(char * cdsn,ftnlen cdsn_len)513 /* Subroutine */ int uismfl_(char *cdsn, ftnlen cdsn_len)
514 {
515 return uicrgb_0_(7, (real *)0, (real *)0, (integer *)0, (real *)0, (real *
516 )0, (real *)0, (integer *)0, (integer *)0, cdsn, (real *)0, (real
517 *)0, cdsn_len);
518 }
519
520