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__27 = 27;
19
20 /* ----------------------------------------------------------------------- */
21 /* UZIQNP / UZIQID / UZIQCP / UZIQVL / UZISVL */
22 /* ----------------------------------------------------------------------- */
23 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
24 /* ----------------------------------------------------------------------- */
uziqnp_0_(int n__,integer * ncp,char * cp,integer * idx,integer * ipara,integer * in,integer * iu,ftnlen cp_len)25 /* Subroutine */ int uziqnp_0_(int n__, integer *ncp, char *cp, integer *idx,
26 integer *ipara, integer *in, integer *iu, ftnlen cp_len)
27 {
28 /* Initialized data */
29
30 static char cparas[8*27] = "IROTLXB " "IROTLXT " "IROTLXU " "IROTLYL "
31 "IROTLYR " "IROTLYU " "IROTCXB " "IROTCXT " "IROTCXU " "IROTCYL "
32 "IROTCYR " "IROTCYU " "ICENTXB " "ICENTXT " "ICENTXU " "ICENTYL "
33 "ICENTYR " "ICENTYU " "INDEXT0 " "INDEXT1 " "INDEXT2 " "INDEXL0 "
34 "INDEXL1 " "INDEXL2 " "IFLAG " "INNER " "IUNDEF ";
35 static integer ix[27] = { 0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,1,1,1,-999,1,3,
36 -999,3,3,-1,1,-999 };
37 static char cparal[40*27] = "BOTTOM_LABEL_ANGLE "
38 "TOP_LABEL_ANGLE " "HORIZONTAL_LABEL_ANG"
39 "LE " "LEFT_LABEL_ANGLE "
40 "RIGHT_LABEL_ANGLE " "VERTICAL_LABEL_ANGLE"
41 " " "BOTTOM_TITLE_ANGLE "
42 "TOP_TITLE_ANGLE " "HORIZONTAL_TITLE_ANG"
43 "LE " "LEFT_TITLE_ANGLE "
44 "RIGHT_TITLE_ANGLE " "VERTICAL_TITLE_ANGLE"
45 " " "BOTTOM_LABEL_CENTERING "
46 "TOP_LABEL_CENTERING " "HORIZONTAL_LABEL_CEN"
47 "TERING " "LEFT_LABEL_CENTERING "
48 "RIGHT_LABEL_CENTERING " "VERTICAL_LABEL_CENTE"
49 "RING " "AXIS_LINE_INDEX0 "
50 "AXIS_LINE_INDEX1 " "AXIS_LINE_INDEX2 "
51 " " "LABEL_INDEX0 "
52 "LABEL_INDEX1 " "LABEL_INDEX2 "
53 " " "LABEL_SIDE_FOR_USER_AXIS "
54 "TICKMARK_SIDE " "----IUNDEF "
55 " ";
56 static logical lfirst = TRUE_;
57
58 /* System generated locals */
59 address a__1[3];
60 integer i__1[3];
61
62 /* Builtin functions */
63 /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
64 s_copy(char *, char *, ftnlen, ftnlen);
65 integer s_wsue(cilist *), do_uio(integer *, char *, ftnlen), e_wsue(void),
66 s_rsue(cilist *), e_rsue(void);
67
68 /* Local variables */
69 static integer n, ios;
70 extern integer lenc_(char *, ftnlen);
71 static char cmsg[80];
72 extern logical lchreq_(char *, char *, ftnlen, ftnlen);
73 extern /* Subroutine */ int rliget_(char *, integer *, integer *, ftnlen),
74 msgdmp_(char *, char *, char *, ftnlen, ftnlen, ftnlen), rtiget_(
75 char *, char *, integer *, integer *, ftnlen, ftnlen);
76
77 /* Fortran I/O blocks */
78 static cilist io___8 = { 1, 0, 0, 0, 0 };
79 static cilist io___9 = { 1, 0, 1, 0, 0 };
80
81
82 /* / SHORT NAME / */
83 switch(n__) {
84 case 1: goto L_uziqid;
85 case 2: goto L_uziqcp;
86 case 3: goto L_uziqcl;
87 case 4: goto L_uziqvl;
88 case 5: goto L_uzisvl;
89 case 6: goto L_uziqin;
90 case 7: goto L_uzisav;
91 case 8: goto L_uzirst;
92 }
93
94 /* / LONG NAME / */
95 *ncp = 27;
96 return 0;
97 /* ----------------------------------------------------------------------- */
98
99 L_uziqid:
100 for (n = 1; n <= 27; ++n) {
101 if (lchreq_(cp, cparas + (n - 1 << 3), cp_len, (ftnlen)8) || lchreq_(
102 cp, cparal + (n - 1) * 40, cp_len, (ftnlen)40)) {
103 *idx = n;
104 return 0;
105 }
106 /* L10: */
107 }
108 /* Writing concatenation */
109 i__1[0] = 11, a__1[0] = "PARAMETER '";
110 i__1[1] = lenc_(cp, cp_len), a__1[1] = cp;
111 i__1[2] = 17, a__1[2] = "' IS NOT DEFINED.";
112 s_cat(cmsg, a__1, i__1, &c__3, (ftnlen)80);
113 msgdmp_("E", "UZIQID", cmsg, (ftnlen)1, (ftnlen)6, (ftnlen)80);
114 return 0;
115 /* ----------------------------------------------------------------------- */
116
117 L_uziqcp:
118 if (1 <= *idx && *idx <= 27) {
119 s_copy(cp, cparas + (*idx - 1 << 3), cp_len, (ftnlen)8);
120 } else {
121 msgdmp_("E", "UZIQCP", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
122 ftnlen)20);
123 }
124 return 0;
125 /* ----------------------------------------------------------------------- */
126
127 L_uziqcl:
128 if (1 <= *idx && *idx <= 27) {
129 s_copy(cp, cparal + (*idx - 1) * 40, cp_len, (ftnlen)40);
130 } else {
131 msgdmp_("E", "UZIQCL", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
132 ftnlen)20);
133 }
134 return 0;
135 /* ----------------------------------------------------------------------- */
136
137 L_uziqvl:
138 if (lfirst) {
139 rtiget_("UZ", cparas, ix, &c__27, (ftnlen)2, (ftnlen)8);
140 rliget_(cparal, ix, &c__27, (ftnlen)40);
141 lfirst = FALSE_;
142 }
143 if (1 <= *idx && *idx <= 27) {
144 *ipara = ix[*idx - 1];
145 } else {
146 msgdmp_("E", "UZIQVL", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
147 ftnlen)20);
148 }
149 return 0;
150 /* ----------------------------------------------------------------------- */
151
152 L_uzisvl:
153 if (lfirst) {
154 rtiget_("UZ", cparas, ix, &c__27, (ftnlen)2, (ftnlen)8);
155 rliget_(cparal, ix, &c__27, (ftnlen)40);
156 lfirst = FALSE_;
157 }
158 if (1 <= *idx && *idx <= 27) {
159 ix[*idx - 1] = *ipara;
160 } else {
161 msgdmp_("E", "UZISVL", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
162 ftnlen)20);
163 }
164 return 0;
165 /* ----------------------------------------------------------------------- */
166
167 L_uziqin:
168 for (n = 1; n <= 27; ++n) {
169 if (lchreq_(cp, cparas + (n - 1 << 3), cp_len, (ftnlen)8) || lchreq_(
170 cp, cparal + (n - 1) * 40, cp_len, (ftnlen)40)) {
171 *in = n;
172 return 0;
173 }
174 /* L20: */
175 }
176 *in = 0;
177 return 0;
178 /* ----------------------------------------------------------------------- */
179
180 L_uzisav:
181 io___8.ciunit = *iu;
182 ios = s_wsue(&io___8);
183 if (ios != 0) {
184 goto L100001;
185 }
186 ios = do_uio(&c__27, (char *)&ix[0], (ftnlen)sizeof(integer));
187 if (ios != 0) {
188 goto L100001;
189 }
190 ios = e_wsue();
191 L100001:
192 if (ios != 0) {
193 msgdmp_("E", "UZISAV", "IOSTAT IS NOT ZERO.", (ftnlen)1, (ftnlen)6, (
194 ftnlen)19);
195 }
196 return 0;
197 /* ----------------------------------------------------------------------- */
198
199 L_uzirst:
200 io___9.ciunit = *iu;
201 ios = s_rsue(&io___9);
202 if (ios != 0) {
203 goto L100002;
204 }
205 ios = do_uio(&c__27, (char *)&ix[0], (ftnlen)sizeof(integer));
206 if (ios != 0) {
207 goto L100002;
208 }
209 ios = e_rsue();
210 L100002:
211 if (ios != 0) {
212 msgdmp_("E", "UZIRST", "IOSTAT IS NOT ZERO.", (ftnlen)1, (ftnlen)6, (
213 ftnlen)19);
214 }
215 return 0;
216 } /* uziqnp_ */
217
uziqnp_(integer * ncp)218 /* Subroutine */ int uziqnp_(integer *ncp)
219 {
220 return uziqnp_0_(0, ncp, (char *)0, (integer *)0, (integer *)0, (integer *
221 )0, (integer *)0, (ftnint)0);
222 }
223
uziqid_(char * cp,integer * idx,ftnlen cp_len)224 /* Subroutine */ int uziqid_(char *cp, integer *idx, ftnlen cp_len)
225 {
226 return uziqnp_0_(1, (integer *)0, cp, idx, (integer *)0, (integer *)0, (
227 integer *)0, cp_len);
228 }
229
uziqcp_(integer * idx,char * cp,ftnlen cp_len)230 /* Subroutine */ int uziqcp_(integer *idx, char *cp, ftnlen cp_len)
231 {
232 return uziqnp_0_(2, (integer *)0, cp, idx, (integer *)0, (integer *)0, (
233 integer *)0, cp_len);
234 }
235
uziqcl_(integer * idx,char * cp,ftnlen cp_len)236 /* Subroutine */ int uziqcl_(integer *idx, char *cp, ftnlen cp_len)
237 {
238 return uziqnp_0_(3, (integer *)0, cp, idx, (integer *)0, (integer *)0, (
239 integer *)0, cp_len);
240 }
241
uziqvl_(integer * idx,integer * ipara)242 /* Subroutine */ int uziqvl_(integer *idx, integer *ipara)
243 {
244 return uziqnp_0_(4, (integer *)0, (char *)0, idx, ipara, (integer *)0, (
245 integer *)0, (ftnint)0);
246 }
247
uzisvl_(integer * idx,integer * ipara)248 /* Subroutine */ int uzisvl_(integer *idx, integer *ipara)
249 {
250 return uziqnp_0_(5, (integer *)0, (char *)0, idx, ipara, (integer *)0, (
251 integer *)0, (ftnint)0);
252 }
253
uziqin_(char * cp,integer * in,ftnlen cp_len)254 /* Subroutine */ int uziqin_(char *cp, integer *in, ftnlen cp_len)
255 {
256 return uziqnp_0_(6, (integer *)0, cp, (integer *)0, (integer *)0, in, (
257 integer *)0, cp_len);
258 }
259
uzisav_(integer * iu)260 /* Subroutine */ int uzisav_(integer *iu)
261 {
262 return uziqnp_0_(7, (integer *)0, (char *)0, (integer *)0, (integer *)0, (
263 integer *)0, iu, (ftnint)0);
264 }
265
uzirst_(integer * iu)266 /* Subroutine */ int uzirst_(integer *iu)
267 {
268 return uziqnp_0_(8, (integer *)0, (char *)0, (integer *)0, (integer *)0, (
269 integer *)0, iu, (ftnint)0);
270 }
271
272