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__31 = 31;
19
20 /* ----------------------------------------------------------------------- */
21 /* UZRQNP / UZRQID / UZRQCP / UZRQVL / UZRSVL */
22 /* ----------------------------------------------------------------------- */
23 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
24 /* ----------------------------------------------------------------------- */
uzrqnp_0_(int n__,integer * ncp,char * cp,integer * idx,real * rpara,integer * in,integer * iu,ftnlen cp_len)25 /* Subroutine */ int uzrqnp_0_(int n__, integer *ncp, char *cp, integer *idx,
26 real *rpara, integer *in, integer *iu, ftnlen cp_len)
27 {
28 /* Initialized data */
29
30 static char cparas[8*31] = "UXUSER " "UYUSER " "ROFFXB " "ROFFXT "
31 "ROFFXU " "ROFFYL " "ROFFYR " "ROFFYU " "ROFGXB " "ROFGXT "
32 "ROFGXU " "ROFGYL " "ROFGYR " "ROFGYU " "RSIZET0 " "RSIZET1 "
33 "RSIZET2 " "RSIZEL0 " "RSIZEL1 " "RSIZEL2 " "RSIZEC0 " "RSIZEC1 "
34 "RSIZEC2 " "XOFFSET " "YOFFSET " "XFACT " "YFACT " "PAD1 "
35 "PAD2 " "RBTWN " "RUNDEF ";
36 static real rx[31] = { -999.f,-999.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,-999.f,.007f,.014f,-999.f,.021f,.028f,-999.f,.028f,
38 .035f,0.f,0.f,1.f,1.f,.7f,1.5f,0.f,-999.f };
39 static char cparal[40*31] = "X_INTERSECTION "
40 "Y_INTERSECTION " "****ROFFXB "
41 " " "****ROFFXT "
42 "****ROFFXU " "****ROFFYL "
43 " " "****ROFFYR "
44 "****ROFFYU " "****ROFGXB "
45 " " "****ROFGXT "
46 "****ROFGXU " "****ROFGYL "
47 " " "****ROFGYR "
48 "****ROFGYU " "TICK_LENGTH0 "
49 " " "TICK_LENGTH1 "
50 "TICK_LENGTH2 " "LABEL_HEIGHT0 "
51 " " "LABEL_HEIGHT1 "
52 "LABEL_HEIGHT2 " "TITLE_HEIGHT0 "
53 " " "TITLE_HEIGHT1 "
54 "TITLE_HEIGHT2 " "X_AXIS_OFFSET "
55 " " "Y_AXIS_OFFSET "
56 "X_AXIS_FACTOR " "Y_AXIS_FACTOR "
57 " " "****PAD1 "
58 "****PAD2 " "SPAN_LABELING_CENTER"
59 "ING " "----RUNDEF ";
60 static logical lfirst = TRUE_;
61
62 /* System generated locals */
63 address a__1[3];
64 integer i__1[3];
65
66 /* Builtin functions */
67 /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
68 s_copy(char *, char *, ftnlen, ftnlen);
69 integer s_wsue(cilist *), do_uio(integer *, char *, ftnlen), e_wsue(void),
70 s_rsue(cilist *), e_rsue(void);
71
72 /* Local variables */
73 static integer n, ios;
74 extern integer lenc_(char *, ftnlen);
75 static char cmsg[80];
76 extern logical lchreq_(char *, char *, ftnlen, ftnlen);
77 extern /* Subroutine */ int msgdmp_(char *, char *, char *, ftnlen,
78 ftnlen, ftnlen), rlrget_(char *, real *, integer *, ftnlen),
79 rtrget_(char *, char *, real *, integer *, ftnlen, ftnlen);
80
81 /* Fortran I/O blocks */
82 static cilist io___8 = { 1, 0, 0, 0, 0 };
83 static cilist io___9 = { 1, 0, 1, 0, 0 };
84
85
86 /* / SHORT NAME / */
87 switch(n__) {
88 case 1: goto L_uzrqid;
89 case 2: goto L_uzrqcp;
90 case 3: goto L_uzrqcl;
91 case 4: goto L_uzrqvl;
92 case 5: goto L_uzrsvl;
93 case 6: goto L_uzrqin;
94 case 7: goto L_uzrsav;
95 case 8: goto L_uzrrst;
96 }
97
98 /* / LONG NAME / */
99 *ncp = 31;
100 return 0;
101 /* ----------------------------------------------------------------------- */
102
103 L_uzrqid:
104 for (n = 1; n <= 31; ++n) {
105 if (lchreq_(cp, cparas + (n - 1 << 3), cp_len, (ftnlen)8) || lchreq_(
106 cp, cparal + (n - 1) * 40, cp_len, (ftnlen)40)) {
107 *idx = n;
108 return 0;
109 }
110 /* L10: */
111 }
112 /* Writing concatenation */
113 i__1[0] = 11, a__1[0] = "PARAMETER '";
114 i__1[1] = lenc_(cp, cp_len), a__1[1] = cp;
115 i__1[2] = 17, a__1[2] = "' IS NOT DEFINED.";
116 s_cat(cmsg, a__1, i__1, &c__3, (ftnlen)80);
117 msgdmp_("E", "UZRQID", cmsg, (ftnlen)1, (ftnlen)6, (ftnlen)80);
118 return 0;
119 /* ----------------------------------------------------------------------- */
120
121 L_uzrqcp:
122 if (1 <= *idx && *idx <= 31) {
123 s_copy(cp, cparas + (*idx - 1 << 3), cp_len, (ftnlen)8);
124 } else {
125 msgdmp_("E", "UZRQCP", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
126 ftnlen)20);
127 }
128 return 0;
129 /* ----------------------------------------------------------------------- */
130
131 L_uzrqcl:
132 if (1 <= *idx && *idx <= 31) {
133 s_copy(cp, cparal + (*idx - 1) * 40, cp_len, (ftnlen)40);
134 } else {
135 msgdmp_("E", "UZRQCL", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
136 ftnlen)20);
137 }
138 return 0;
139 /* ----------------------------------------------------------------------- */
140
141 L_uzrqvl:
142 if (lfirst) {
143 rtrget_("UZ", cparas, rx, &c__31, (ftnlen)2, (ftnlen)8);
144 rlrget_(cparal, rx, &c__31, (ftnlen)40);
145 lfirst = FALSE_;
146 }
147 if (1 <= *idx && *idx <= 31) {
148 *rpara = rx[*idx - 1];
149 } else {
150 msgdmp_("E", "UZRQVL", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
151 ftnlen)20);
152 }
153 return 0;
154 /* ----------------------------------------------------------------------- */
155
156 L_uzrsvl:
157 if (lfirst) {
158 rtrget_("UZ", cparas, rx, &c__31, (ftnlen)2, (ftnlen)8);
159 rlrget_(cparal, rx, &c__31, (ftnlen)40);
160 lfirst = FALSE_;
161 }
162 if (1 <= *idx && *idx <= 31) {
163 rx[*idx - 1] = *rpara;
164 } else {
165 msgdmp_("E", "UZRSVL", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
166 ftnlen)20);
167 }
168 return 0;
169 /* ----------------------------------------------------------------------- */
170
171 L_uzrqin:
172 for (n = 1; n <= 31; ++n) {
173 if (lchreq_(cp, cparas + (n - 1 << 3), cp_len, (ftnlen)8) || lchreq_(
174 cp, cparal + (n - 1) * 40, cp_len, (ftnlen)40)) {
175 *in = n;
176 return 0;
177 }
178 /* L20: */
179 }
180 *in = 0;
181 return 0;
182 /* ----------------------------------------------------------------------- */
183
184 L_uzrsav:
185 io___8.ciunit = *iu;
186 ios = s_wsue(&io___8);
187 if (ios != 0) {
188 goto L100001;
189 }
190 ios = do_uio(&c__31, (char *)&rx[0], (ftnlen)sizeof(real));
191 if (ios != 0) {
192 goto L100001;
193 }
194 ios = e_wsue();
195 L100001:
196 if (ios != 0) {
197 msgdmp_("E", "UZRSAV", "IOSTAT IS NOT ZERO.", (ftnlen)1, (ftnlen)6, (
198 ftnlen)19);
199 }
200 return 0;
201 /* ----------------------------------------------------------------------- */
202
203 L_uzrrst:
204 io___9.ciunit = *iu;
205 ios = s_rsue(&io___9);
206 if (ios != 0) {
207 goto L100002;
208 }
209 ios = do_uio(&c__31, (char *)&rx[0], (ftnlen)sizeof(real));
210 if (ios != 0) {
211 goto L100002;
212 }
213 ios = e_rsue();
214 L100002:
215 if (ios != 0) {
216 msgdmp_("E", "UZRRST", "IOSTAT IS NOT ZERO.", (ftnlen)1, (ftnlen)6, (
217 ftnlen)19);
218 }
219 return 0;
220 } /* uzrqnp_ */
221
uzrqnp_(integer * ncp)222 /* Subroutine */ int uzrqnp_(integer *ncp)
223 {
224 return uzrqnp_0_(0, ncp, (char *)0, (integer *)0, (real *)0, (integer *)0,
225 (integer *)0, (ftnint)0);
226 }
227
uzrqid_(char * cp,integer * idx,ftnlen cp_len)228 /* Subroutine */ int uzrqid_(char *cp, integer *idx, ftnlen cp_len)
229 {
230 return uzrqnp_0_(1, (integer *)0, cp, idx, (real *)0, (integer *)0, (
231 integer *)0, cp_len);
232 }
233
uzrqcp_(integer * idx,char * cp,ftnlen cp_len)234 /* Subroutine */ int uzrqcp_(integer *idx, char *cp, ftnlen cp_len)
235 {
236 return uzrqnp_0_(2, (integer *)0, cp, idx, (real *)0, (integer *)0, (
237 integer *)0, cp_len);
238 }
239
uzrqcl_(integer * idx,char * cp,ftnlen cp_len)240 /* Subroutine */ int uzrqcl_(integer *idx, char *cp, ftnlen cp_len)
241 {
242 return uzrqnp_0_(3, (integer *)0, cp, idx, (real *)0, (integer *)0, (
243 integer *)0, cp_len);
244 }
245
uzrqvl_(integer * idx,real * rpara)246 /* Subroutine */ int uzrqvl_(integer *idx, real *rpara)
247 {
248 return uzrqnp_0_(4, (integer *)0, (char *)0, idx, rpara, (integer *)0, (
249 integer *)0, (ftnint)0);
250 }
251
uzrsvl_(integer * idx,real * rpara)252 /* Subroutine */ int uzrsvl_(integer *idx, real *rpara)
253 {
254 return uzrqnp_0_(5, (integer *)0, (char *)0, idx, rpara, (integer *)0, (
255 integer *)0, (ftnint)0);
256 }
257
uzrqin_(char * cp,integer * in,ftnlen cp_len)258 /* Subroutine */ int uzrqin_(char *cp, integer *in, ftnlen cp_len)
259 {
260 return uzrqnp_0_(6, (integer *)0, cp, (integer *)0, (real *)0, in, (
261 integer *)0, cp_len);
262 }
263
uzrsav_(integer * iu)264 /* Subroutine */ int uzrsav_(integer *iu)
265 {
266 return uzrqnp_0_(7, (integer *)0, (char *)0, (integer *)0, (real *)0, (
267 integer *)0, iu, (ftnint)0);
268 }
269
uzrrst_(integer * iu)270 /* Subroutine */ int uzrrst_(integer *iu)
271 {
272 return uzrqnp_0_(8, (integer *)0, (char *)0, (integer *)0, (real *)0, (
273 integer *)0, iu, (ftnint)0);
274 }
275
276