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__23 = 23;
19
20 /* ----------------------------------------------------------------------- */
21 /* INTEGER PARAMATER CONTROL */
22 /* ----------------------------------------------------------------------- */
23 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
24 /* ----------------------------------------------------------------------- */
sgiqnp_0_(int n__,integer * ncp,char * cp,integer * idx,integer * ipara,integer * in,ftnlen cp_len)25 /* Subroutine */ int sgiqnp_0_(int n__, integer *ncp, char *cp, integer *idx,
26 integer *ipara, integer *in, ftnlen cp_len)
27 {
28 /* Initialized data */
29
30 static char cparas[8*23] = "IRMODE " "MOVE " "NBITS " "ISUP "
31 "ISUB " "IRST " "NPMSKIP " "IFONT " "ICLRMAP " "IROT "
32 "INDEXC " "NBUFF " "IATONE " "IWS " "ITR " "IBGCLI "
33 "NFRAME " "NPAGE " "NLEVEL " "INDEX " "ITR3 " "IXC3 "
34 "IYC3 ";
35 static integer ix[23] = { 0,1,16,124,95,34,1,1,1,0,0,200,999,0,1,999,0,0,
36 0,1,1,1,2 };
37 static char cparal[40*23] = "BOUNDARY_DIRECTION "
38 "LINE_RESUME_MODE " "PATTERN_BIT_LENGTH "
39 " " "BEGIN_SUPERSCRIPT "
40 "BEGIN_SUBSCRIPT " "END_SCRIPT "
41 " " "POLIMARKER_INTERVAL "
42 "FONT_NUMBER " "COLORMAP_NUMBER "
43 " " "LINE_LABEL_ROTATION_ANGLE "
44 "LABEL_CHAR_INDEX " "LINE_BUFFERING_LENGT"
45 "H " "ARROWHEAD_SHADE_PATTERN "
46 "++++IWS " "++++ITR "
47 " " "BACKGROUND_COLOR_INDEX "
48 "****NFRAME " "****NPAGE "
49 " " "****NLEVEL "
50 "CORNERMARK_INDEX " "++++ITR3 "
51 " " "++++IXC3 "
52 "++++IYC3 ";
53 static logical lfirst = TRUE_;
54
55 /* System generated locals */
56 address a__1[3];
57 integer i__1[3];
58
59 /* Builtin functions */
60 /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
61 s_copy(char *, char *, ftnlen, ftnlen);
62
63 /* Local variables */
64 static integer n;
65 extern integer lenc_(char *, ftnlen);
66 static char cmsg[80];
67 extern logical lchreq_(char *, char *, ftnlen, ftnlen);
68 extern /* Subroutine */ int msgdmp_(char *, char *, char *, ftnlen,
69 ftnlen, ftnlen), rliget_(char *, integer *, integer *, ftnlen),
70 rtiget_(char *, char *, integer *, integer *, ftnlen, ftnlen);
71
72 /* / SHORT NAME / */
73 switch(n__) {
74 case 1: goto L_sgiqid;
75 case 2: goto L_sgiqcp;
76 case 3: goto L_sgiqcl;
77 case 4: goto L_sgiqvl;
78 case 5: goto L_sgisvl;
79 case 6: goto L_sgiqin;
80 }
81
82 /* / LONG NAME / */
83 *ncp = 23;
84 return 0;
85 /* ----------------------------------------------------------------------- */
86
87 L_sgiqid:
88 for (n = 1; n <= 23; ++n) {
89 if (lchreq_(cp, cparas + (n - 1 << 3), cp_len, (ftnlen)8) || lchreq_(
90 cp, cparal + (n - 1) * 40, cp_len, (ftnlen)40)) {
91 *idx = n;
92 return 0;
93 }
94 /* L10: */
95 }
96 /* Writing concatenation */
97 i__1[0] = 11, a__1[0] = "PARAMETER '";
98 i__1[1] = lenc_(cp, cp_len), a__1[1] = cp;
99 i__1[2] = 17, a__1[2] = "' IS NOT DEFINED.";
100 s_cat(cmsg, a__1, i__1, &c__3, (ftnlen)80);
101 msgdmp_("E", "SGIQID", cmsg, (ftnlen)1, (ftnlen)6, (ftnlen)80);
102 return 0;
103 /* ----------------------------------------------------------------------- */
104
105 L_sgiqcp:
106 if (1 <= *idx && *idx <= 23) {
107 s_copy(cp, cparas + (*idx - 1 << 3), cp_len, (ftnlen)8);
108 } else {
109 msgdmp_("E", "SGIQCP", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
110 ftnlen)20);
111 }
112 return 0;
113 /* ----------------------------------------------------------------------- */
114
115 L_sgiqcl:
116 if (1 <= *idx && *idx <= 23) {
117 s_copy(cp, cparal + (*idx - 1) * 40, cp_len, (ftnlen)40);
118 } else {
119 msgdmp_("E", "SGIQCL", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
120 ftnlen)20);
121 }
122 return 0;
123 /* ----------------------------------------------------------------------- */
124
125 L_sgiqvl:
126 if (lfirst) {
127 rtiget_("SG", cparas, ix, &c__23, (ftnlen)2, (ftnlen)8);
128 rliget_(cparal, ix, &c__23, (ftnlen)40);
129 lfirst = FALSE_;
130 }
131 if (1 <= *idx && *idx <= 23) {
132 *ipara = ix[*idx - 1];
133 } else {
134 msgdmp_("E", "SGIQVL", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
135 ftnlen)20);
136 }
137 return 0;
138 /* ----------------------------------------------------------------------- */
139
140 L_sgisvl:
141 if (lfirst) {
142 rtiget_("SG", cparas, ix, &c__23, (ftnlen)2, (ftnlen)8);
143 rliget_(cparal, ix, &c__23, (ftnlen)40);
144 lfirst = FALSE_;
145 }
146 if (1 <= *idx && *idx <= 23) {
147 ix[*idx - 1] = *ipara;
148 } else {
149 msgdmp_("E", "SGISVL", "IDX IS OUT OF RANGE.", (ftnlen)1, (ftnlen)6, (
150 ftnlen)20);
151 }
152 return 0;
153 /* ----------------------------------------------------------------------- */
154
155 L_sgiqin:
156 for (n = 1; n <= 23; ++n) {
157 if (lchreq_(cp, cparas + (n - 1 << 3), cp_len, (ftnlen)8) || lchreq_(
158 cp, cparal + (n - 1) * 40, cp_len, (ftnlen)40)) {
159 *in = n;
160 return 0;
161 }
162 /* L20: */
163 }
164 *in = 0;
165 return 0;
166 } /* sgiqnp_ */
167
sgiqnp_(integer * ncp)168 /* Subroutine */ int sgiqnp_(integer *ncp)
169 {
170 return sgiqnp_0_(0, ncp, (char *)0, (integer *)0, (integer *)0, (integer *
171 )0, (ftnint)0);
172 }
173
sgiqid_(char * cp,integer * idx,ftnlen cp_len)174 /* Subroutine */ int sgiqid_(char *cp, integer *idx, ftnlen cp_len)
175 {
176 return sgiqnp_0_(1, (integer *)0, cp, idx, (integer *)0, (integer *)0,
177 cp_len);
178 }
179
sgiqcp_(integer * idx,char * cp,ftnlen cp_len)180 /* Subroutine */ int sgiqcp_(integer *idx, char *cp, ftnlen cp_len)
181 {
182 return sgiqnp_0_(2, (integer *)0, cp, idx, (integer *)0, (integer *)0,
183 cp_len);
184 }
185
sgiqcl_(integer * idx,char * cp,ftnlen cp_len)186 /* Subroutine */ int sgiqcl_(integer *idx, char *cp, ftnlen cp_len)
187 {
188 return sgiqnp_0_(3, (integer *)0, cp, idx, (integer *)0, (integer *)0,
189 cp_len);
190 }
191
sgiqvl_(integer * idx,integer * ipara)192 /* Subroutine */ int sgiqvl_(integer *idx, integer *ipara)
193 {
194 return sgiqnp_0_(4, (integer *)0, (char *)0, idx, ipara, (integer *)0, (
195 ftnint)0);
196 }
197
sgisvl_(integer * idx,integer * ipara)198 /* Subroutine */ int sgisvl_(integer *idx, integer *ipara)
199 {
200 return sgiqnp_0_(5, (integer *)0, (char *)0, idx, ipara, (integer *)0, (
201 ftnint)0);
202 }
203
sgiqin_(char * cp,integer * in,ftnlen cp_len)204 /* Subroutine */ int sgiqin_(char *cp, integer *in, ftnlen cp_len)
205 {
206 return sgiqnp_0_(6, (integer *)0, cp, (integer *)0, (integer *)0, in,
207 cp_len);
208 }
209
210