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__2 = 2;
18 static integer c__3 = 3;
19 static logical c_true = TRUE_;
20 static real c_b34 = 0.f;
21
22 /* ----------------------------------------------------------------------- */
23 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
24 /* ----------------------------------------------------------------------- */
usxinz_0_(int n__,char * csa,real * faca,real * offa,ftnlen csa_len)25 /* Subroutine */ int usxinz_0_(int n__, char *csa, real *faca, real *offa,
26 ftnlen csa_len)
27 {
28 /* System generated locals */
29 address a__1[2], a__2[3];
30 integer i__1[2], i__2[3], i__3, i__4;
31 real r__1;
32 char ch__1[6], ch__2[7], ch__3[32];
33
34 /* Builtin functions */
35 /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
36 integer s_cmp(char *, char *, ftnlen, ftnlen);
37 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
38
39 /* Local variables */
40 static char cs[1];
41 static integer nlt;
42 static real fac0, fac1, off0, off1;
43 static char cmin[16];
44 static logical loff;
45 static char cmax[16], csub[32];
46 static real roff, rofg, rlen;
47 static char cpos[1];
48 static logical lsub;
49 static char cttl[32];
50 extern integer lenz_(char *, ftnlen);
51 static real xmin, ymin, xmax, ymax;
52 static char cfmt0[16], cfmt1[16];
53 extern /* Subroutine */ int cladj_(char *, ftnlen);
54 static logical label;
55 extern /* Subroutine */ int chval_(char *, real *, char *, ftnlen, ftnlen)
56 ;
57 static char cunit__[32];
58 static real sizel;
59 extern /* Character */ VOID csblbl_(char *, ftnlen, real *, real *, char *
60 , ftnlen);
61 static real factor, rundef;
62 static char ctitle[32];
63 extern /* Subroutine */ int glrget_(char *, real *, ftnlen);
64 static real offset;
65 extern /* Subroutine */ int uscget_(char *, char *, ftnlen, ftnlen),
66 uzcget_(char *, char *, ftnlen, ftnlen), sgqwnd_(real *, real *,
67 real *, real *), uslget_(char *, logical *, ftnlen), usrget_(char
68 *, real *, ftnlen), uzlget_(char *, logical *, ftnlen), uzcset_(
69 char *, char *, ftnlen, ftnlen), uzrget_(char *, real *, ftnlen),
70 usrset_(char *, real *, ftnlen), uzlset_(char *, logical *,
71 ftnlen), usxsub_(char *, char *, char *, real *, ftnlen, ftnlen,
72 ftnlen), uxsaxs_(char *, ftnlen), uzrset_(char *, real *, ftnlen),
73 uxsttl_(char *, char *, real *, ftnlen, ftnlen);
74
75 switch(n__) {
76 case 1: goto L_usxtlz;
77 }
78
79 glrget_("RUNDEF", &rundef, (ftnlen)6);
80 *(unsigned char *)cs = *(unsigned char *)csa;
81 /* Writing concatenation */
82 i__1[0] = 5, a__1[0] = "ROFFX";
83 i__1[1] = 1, a__1[1] = cs;
84 s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)6);
85 uzrget_(ch__1, &roff, (ftnlen)6);
86 /* Writing concatenation */
87 i__1[0] = 5, a__1[0] = "ROFGX";
88 i__1[1] = 1, a__1[1] = cs;
89 s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)6);
90 uzrget_(ch__1, &rofg, (ftnlen)6);
91 if (roff != rofg) {
92 uxsaxs_(cs, (ftnlen)1);
93 }
94 uzrget_("RSIZEL1", &sizel, (ftnlen)7);
95 /* Writing concatenation */
96 i__2[0] = 5, a__2[0] = "SOFFX";
97 i__2[1] = 1, a__2[1] = cs;
98 i__2[2] = 1, a__2[2] = "R";
99 s_cat(ch__2, a__2, i__2, &c__3, (ftnlen)7);
100 r__1 = sizel * .86f;
101 usrset_(ch__2, &r__1, (ftnlen)7);
102 /* Writing concatenation */
103 i__2[0] = 5, a__2[0] = "SOFFX";
104 i__2[1] = 1, a__2[1] = cs;
105 i__2[2] = 1, a__2[2] = "L";
106 s_cat(ch__2, a__2, i__2, &c__3, (ftnlen)7);
107 r__1 = -sizel * .86f;
108 usrset_(ch__2, &r__1, (ftnlen)7);
109 uzlget_("LOFFSET", &loff, (ftnlen)7);
110 if (loff) {
111 uzrget_("XOFFSET", &off0, (ftnlen)7);
112 uzrget_("XFACT", &fac0, (ftnlen)5);
113 } else {
114 off0 = 0.f;
115 fac0 = 1.f;
116 }
117 usrget_("XOFF", &off1, (ftnlen)4);
118 usrget_("XFAC", &fac1, (ftnlen)4);
119 if (off1 == rundef) {
120 off1 = 0.f;
121 }
122 if (fac1 == rundef) {
123 fac1 = 1.f;
124 }
125 *offa = off1;
126 *faca = fac1;
127 factor = fac0 / fac1;
128 offset = (off0 - off1) / fac1;
129 uzlset_("LOFFSET", &c_true, (ftnlen)7);
130 uzrset_("XOFFSET", &offset, (ftnlen)7);
131 uzrset_("XFACT", &factor, (ftnlen)5);
132 uzcget_("CXFMT", cfmt0, (ftnlen)5, (ftnlen)16);
133 uscget_("CXFMT", cfmt1, (ftnlen)5, (ftnlen)16);
134 if (s_cmp(cfmt1, " ", (ftnlen)16, (ftnlen)1) == 0) {
135 s_copy(cfmt1, cfmt0, (ftnlen)16, (ftnlen)16);
136 }
137 uzcset_("CXFMT", cfmt1, (ftnlen)5, (ftnlen)16);
138 return 0;
139 /* ------------------------------------------------------------- */
140
141 L_usxtlz:
142 sgqwnd_(&xmin, &xmax, &ymin, &ymax);
143 /* Writing concatenation */
144 i__1[0] = 6, a__1[0] = "LABELX";
145 i__1[1] = 1, a__1[1] = cs;
146 s_cat(ch__2, a__1, i__1, &c__2, (ftnlen)7);
147 uzlget_(ch__2, &label, (ftnlen)7);
148 uscget_("CXUNIT", cunit__, (ftnlen)6, (ftnlen)32);
149 uscget_("CXTTL ", cttl, (ftnlen)6, (ftnlen)32);
150 if (label) {
151 csblbl_(ch__3, (ftnlen)32, &fac1, &off1, cunit__, (ftnlen)32);
152 s_copy(csub, ch__3, (ftnlen)32, (ftnlen)32);
153 uslget_("LXSUB", &lsub, (ftnlen)5);
154 if (lenz_(csub, (ftnlen)32) != 0) {
155 if (lsub) {
156 r__1 = xmin * factor + offset;
157 chval_(cfmt1, &r__1, cmin, (ftnlen)16, (ftnlen)16);
158 r__1 = xmax * factor + offset;
159 chval_(cfmt1, &r__1, cmax, (ftnlen)16, (ftnlen)16);
160 /* Computing MAX */
161 i__3 = lenz_(cmin, (ftnlen)16), i__4 = lenz_(cmax, (ftnlen)16)
162 ;
163 rlen = (real) max(i__3,i__4);
164 uscget_("CXSPOS", cpos, (ftnlen)6, (ftnlen)1);
165 usxsub_(cs, cpos, csub, &rlen, (ftnlen)1, (ftnlen)1, (ftnlen)
166 32);
167 s_copy(ctitle, cttl, (ftnlen)32, (ftnlen)32);
168 } else {
169 nlt = lenz_(cttl, (ftnlen)32);
170 /* Writing concatenation */
171 i__1[0] = nlt + 1, a__1[0] = cttl;
172 i__1[1] = 32, a__1[1] = csub;
173 s_cat(ctitle, a__1, i__1, &c__2, (ftnlen)32);
174 }
175 } else {
176 s_copy(ctitle, cttl, (ftnlen)32, (ftnlen)32);
177 }
178 cladj_(ctitle, (ftnlen)32);
179 if (lenz_(ctitle, (ftnlen)32) != 0) {
180 uxsttl_(cs, ctitle, &c_b34, (ftnlen)1, (ftnlen)32);
181 }
182 }
183 uzrset_("XOFFSET", &off0, (ftnlen)7);
184 uzrset_("XFACT", &fac0, (ftnlen)5);
185 uzcset_("CXFMT", cfmt0, (ftnlen)5, (ftnlen)16);
186 return 0;
187 } /* usxinz_ */
188
usxinz_(char * csa,real * faca,real * offa,ftnlen csa_len)189 /* Subroutine */ int usxinz_(char *csa, real *faca, real *offa, ftnlen
190 csa_len)
191 {
192 return usxinz_0_(0, csa, faca, offa, csa_len);
193 }
194
usxtlz_(void)195 /* Subroutine */ int usxtlz_(void)
196 {
197 return usxinz_0_(1, (char *)0, (real *)0, (real *)0, (ftnint)0);
198 }
199
200