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__3 = 3;
18 static integer c__10 = 10;
19
20 /* ----------------------------------------------------------------------- */
21 /* UZLQNP / UZLQID / UZLQCP / UZLQVL / UZLSVL */
22 /* ----------------------------------------------------------------------- */
23 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
24 /* ----------------------------------------------------------------------- */
uzlqnp_0_(int n__,integer * ncp,char * cp,integer * idx,logical * lpara,integer * in,integer * iu,ftnlen cp_len)25 /* Subroutine */ int uzlqnp_0_(int n__, integer *ncp, char *cp, integer *idx,
26 logical *lpara, integer *in, integer *iu, ftnlen cp_len)
27 {
28 /* Initialized data */
29
30 static char cparas[8*10] = "LABELXB " "LABELXT " "LABELXU " "LABELYL "
31 "LABELYR " "LABELYU " "LOFFSET " "LBTWN " "LBOUND " "LBMSG ";
32 static logical lx[10] = { TRUE_,FALSE_,TRUE_,TRUE_,FALSE_,TRUE_,FALSE_,
33 FALSE_,FALSE_,TRUE_ };
34 static char cparal[40*10] = "DRAW_BOTTOM_LABEL "
35 "DRAW_TOP_LABEL " "DRAW_HORIZONTAL_LABE"
36 "L " "DRAW_LEFT_LABEL "
37 "DRAW_RIGHT_LABEL " "DRAW_VERTICAL_LABEL "
38 " " "ENABLE_LINEAR_OFFSET "
39 "ENABLE_SPAN_LABELING " "TITLE_OVER_VIEWPORT "
40 " " "TITLE_OVER_VIEWPORT_MESSAGE ";
41 static logical lfirst = TRUE_;
42
43 /* System generated locals */
44 address a__1[3];
45 integer i__1[3];
46
47 /* Builtin functions */
48 /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
49 s_copy(char *, char *, ftnlen, ftnlen);
50 integer s_wsue(cilist *), do_uio(integer *, char *, ftnlen), e_wsue(void),
51 s_rsue(cilist *), e_rsue(void);
52
53 /* Local variables */
54 static integer n, ios;
55 extern integer lenc_(char *, ftnlen);
56 static char cmsg[80];
57 extern logical lchreq_(char *, char *, ftnlen, ftnlen);
58 extern /* Subroutine */ int msgdmp_(char *, char *, char *, ftnlen,
59 ftnlen, ftnlen), rllget_(char *, logical *, integer *, ftnlen),
60 rtlget_(char *, char *, logical *, integer *, ftnlen, ftnlen);
61
62 /* Fortran I/O blocks */
63 static cilist io___8 = { 1, 0, 0, 0, 0 };
64 static cilist io___9 = { 1, 0, 1, 0, 0 };
65
66
67 /* / SHORT NAME / */
68 switch(n__) {
69 case 1: goto L_uzlqid;
70 case 2: goto L_uzlqcp;
71 case 3: goto L_uzlqcl;
72 case 4: goto L_uzlqvl;
73 case 5: goto L_uzlsvl;
74 case 6: goto L_uzlqin;
75 case 7: goto L_uzlsav;
76 case 8: goto L_uzlrst;
77 }
78
79 /* / LONG NAME / */
80 *ncp = 10;
81 return 0;
82 /* ----------------------------------------------------------------------- */
83
84 L_uzlqid:
85 for (n = 1; n <= 10; ++n) {
86 if (lchreq_(cp, cparas + (n - 1 << 3), cp_len, (ftnlen)8) || lchreq_(
87 cp, cparal + (n - 1) * 40, cp_len, (ftnlen)40)) {
88 *idx = n;
89 return 0;
90 }
91 /* L10: */
92 }
93 /* Writing concatenation */
94 i__1[0] = 11, a__1[0] = "PARAMETER '";
95 i__1[1] = lenc_(cp, cp_len), a__1[1] = cp;
96 i__1[2] = 17, a__1[2] = "' IS NOT DEFINED.";
97 s_cat(cmsg, a__1, i__1, &c__3, (ftnlen)80);
98 msgdmp_("E", "UZLQID", cmsg, (ftnlen)1, (ftnlen)6, (ftnlen)80);
99 return 0;
100 /* ----------------------------------------------------------------------- */
101
102 L_uzlqcp:
103 if (1 <= *idx && *idx <= 10) {
104 s_copy(cp, cparas + (*idx - 1 << 3), cp_len, (ftnlen)8);
105 } else {
106 msgdmp_("E", "UZLQCP", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
107 ftnlen)20);
108 }
109 return 0;
110 /* ----------------------------------------------------------------------- */
111
112 L_uzlqcl:
113 if (1 <= *idx && *idx <= 10) {
114 s_copy(cp, cparal + (*idx - 1) * 40, cp_len, (ftnlen)40);
115 } else {
116 msgdmp_("E", "UZLQCL", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
117 ftnlen)20);
118 }
119 return 0;
120 /* ----------------------------------------------------------------------- */
121
122 L_uzlqvl:
123 if (lfirst) {
124 rtlget_("UZ", cparas, lx, &c__10, (ftnlen)2, (ftnlen)8);
125 rllget_(cparal, lx, &c__10, (ftnlen)40);
126 lfirst = FALSE_;
127 }
128 if (1 <= *idx && *idx <= 10) {
129 *lpara = lx[*idx - 1];
130 } else {
131 msgdmp_("E", "UZLQVL", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
132 ftnlen)20);
133 }
134 return 0;
135 /* ----------------------------------------------------------------------- */
136
137 L_uzlsvl:
138 if (lfirst) {
139 rtlget_("UZ", cparas, lx, &c__10, (ftnlen)2, (ftnlen)8);
140 rllget_(cparal, lx, &c__10, (ftnlen)40);
141 lfirst = FALSE_;
142 }
143 if (1 <= *idx && *idx <= 10) {
144 lx[*idx - 1] = *lpara;
145 } else {
146 msgdmp_("E", "UZLSVL", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
147 ftnlen)20);
148 }
149 return 0;
150 /* ----------------------------------------------------------------------- */
151
152 L_uzlqin:
153 for (n = 1; n <= 10; ++n) {
154 if (lchreq_(cp, cparas + (n - 1 << 3), cp_len, (ftnlen)8) || lchreq_(
155 cp, cparal + (n - 1) * 40, cp_len, (ftnlen)40)) {
156 *in = n;
157 return 0;
158 }
159 /* L20: */
160 }
161 *in = 0;
162 return 0;
163 /* ----------------------------------------------------------------------- */
164
165 L_uzlsav:
166 io___8.ciunit = *iu;
167 ios = s_wsue(&io___8);
168 if (ios != 0) {
169 goto L100001;
170 }
171 ios = do_uio(&c__10, (char *)&lx[0], (ftnlen)sizeof(logical));
172 if (ios != 0) {
173 goto L100001;
174 }
175 ios = e_wsue();
176 L100001:
177 if (ios != 0) {
178 msgdmp_("E", "UZLSAV", "IOSTAT IS NOT ZERO.", (ftnlen)1, (ftnlen)6, (
179 ftnlen)19);
180 }
181 return 0;
182 /* ----------------------------------------------------------------------- */
183
184 L_uzlrst:
185 io___9.ciunit = *iu;
186 ios = s_rsue(&io___9);
187 if (ios != 0) {
188 goto L100002;
189 }
190 ios = do_uio(&c__10, (char *)&lx[0], (ftnlen)sizeof(logical));
191 if (ios != 0) {
192 goto L100002;
193 }
194 ios = e_rsue();
195 L100002:
196 if (ios != 0) {
197 msgdmp_("E", "UZLRST", "IOSTAT IS NOT ZERO.", (ftnlen)1, (ftnlen)6, (
198 ftnlen)19);
199 }
200 return 0;
201 } /* uzlqnp_ */
202
uzlqnp_(integer * ncp)203 /* Subroutine */ int uzlqnp_(integer *ncp)
204 {
205 return uzlqnp_0_(0, ncp, (char *)0, (integer *)0, (logical *)0, (integer *
206 )0, (integer *)0, (ftnint)0);
207 }
208
uzlqid_(char * cp,integer * idx,ftnlen cp_len)209 /* Subroutine */ int uzlqid_(char *cp, integer *idx, ftnlen cp_len)
210 {
211 return uzlqnp_0_(1, (integer *)0, cp, idx, (logical *)0, (integer *)0, (
212 integer *)0, cp_len);
213 }
214
uzlqcp_(integer * idx,char * cp,ftnlen cp_len)215 /* Subroutine */ int uzlqcp_(integer *idx, char *cp, ftnlen cp_len)
216 {
217 return uzlqnp_0_(2, (integer *)0, cp, idx, (logical *)0, (integer *)0, (
218 integer *)0, cp_len);
219 }
220
uzlqcl_(integer * idx,char * cp,ftnlen cp_len)221 /* Subroutine */ int uzlqcl_(integer *idx, char *cp, ftnlen cp_len)
222 {
223 return uzlqnp_0_(3, (integer *)0, cp, idx, (logical *)0, (integer *)0, (
224 integer *)0, cp_len);
225 }
226
uzlqvl_(integer * idx,logical * lpara)227 /* Subroutine */ int uzlqvl_(integer *idx, logical *lpara)
228 {
229 return uzlqnp_0_(4, (integer *)0, (char *)0, idx, lpara, (integer *)0, (
230 integer *)0, (ftnint)0);
231 }
232
uzlsvl_(integer * idx,logical * lpara)233 /* Subroutine */ int uzlsvl_(integer *idx, logical *lpara)
234 {
235 return uzlqnp_0_(5, (integer *)0, (char *)0, idx, lpara, (integer *)0, (
236 integer *)0, (ftnint)0);
237 }
238
uzlqin_(char * cp,integer * in,ftnlen cp_len)239 /* Subroutine */ int uzlqin_(char *cp, integer *in, ftnlen cp_len)
240 {
241 return uzlqnp_0_(6, (integer *)0, cp, (integer *)0, (logical *)0, in, (
242 integer *)0, cp_len);
243 }
244
uzlsav_(integer * iu)245 /* Subroutine */ int uzlsav_(integer *iu)
246 {
247 return uzlqnp_0_(7, (integer *)0, (char *)0, (integer *)0, (logical *)0, (
248 integer *)0, iu, (ftnint)0);
249 }
250
uzlrst_(integer * iu)251 /* Subroutine */ int uzlrst_(integer *iu)
252 {
253 return uzlqnp_0_(8, (integer *)0, (char *)0, (integer *)0, (logical *)0, (
254 integer *)0, iu, (ftnint)0);
255 }
256
257