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