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 real c_b9 = 0.f;
18 static real c_b16 = 1.f;
19 static integer c__1 = 1;
20
21 /* ----------------------------------------------------------------------- */
22 /* CONTROL */
23 /* ----------------------------------------------------------------------- */
24 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
25 /* ----------------------------------------------------------------------- */
sgopn_0_(int n__,integer * iws)26 /* Subroutine */ int sgopn_0_(int n__, integer *iws)
27 {
28 /* System generated locals */
29 real r__1, r__2;
30
31 /* Local variables */
32 static integer nw;
33 static real wx0, wy0;
34 static integer ipg, ifr, jfr, lev, itr, jtr, jws;
35 static real rxm, rym, wxl, wyl, fact;
36 static integer iwsx, ipage;
37 static logical lpage;
38 static real xamin, yamin;
39 static logical lfull;
40 static real xamax, yamax, rxmin, rymin, rxmax, rymax, wxmin, wymin, wxmax,
41 wymax, wsxmn, wsymn, wsxmx, wsymx;
42 extern /* Subroutine */ int slpage_(integer *, integer *, integer *),
43 sgiget_(char *, integer *, ftnlen), sglget_(char *, logical *,
44 ftnlen), msgdmp_(char *, char *, char *, ftnlen, ftnlen, ftnlen),
45 sgiset_(char *, integer *, ftnlen), swdcls_(void), slpcnr_(void),
46 swiget_(char *, integer *, ftnlen);
47 static logical lfirst;
48 extern /* Subroutine */ int slinit_(real *, real *, real *), sgswnd_(real
49 *, real *, real *, real *), sgstrf_(void), slqrct_(integer *,
50 integer *, real *, real *, real *, real *), swdopn_(void),
51 swpcls_(void), swiset_(char *, integer *, ftnlen), sgstrn_(
52 integer *), slpttl_(void), swqrct_(real *, real *, real *, real *,
53 real *), stswrc_(real *, real *, real *, real *), sgsvpt_(real *,
54 real *, real *, real *), swpopn_(void), swsrot_(integer *),
55 stqwtr_(real *, real *, real *, real *, real *, real *, real *,
56 real *, integer *), stswtr_(real *, real *, real *, real *, real *
57 , real *, real *, real *, integer *);
58
59 /* / SET WORKSTATION NUMBER / */
60 switch(n__) {
61 case 1: goto L_sginit;
62 case 2: goto L_sgfrm;
63 case 3: goto L_sgcls;
64 }
65
66 sgiset_("IWS", iws, (ftnlen)3);
67 /* ----------------------------------------------------------------------- */
68
69 L_sginit:
70 /* / SET INITIALIZATION FLAG / */
71 lfirst = TRUE_;
72 /* / CHECK WORKSTATION NUMBER / */
73 sgiget_("IWS", &iwsx, (ftnlen)3);
74 swiget_("MAXWNU", &nw, (ftnlen)6);
75 jws = abs(iwsx);
76 if (! (1 <= jws && jws <= nw)) {
77 msgdmp_("E", "SGINIT", "WORKSTATION NUMBER IS INVALID.", (ftnlen)1, (
78 ftnlen)6, (ftnlen)30);
79 }
80 /* / OPEN WORKSTATION / */
81 swiset_("IWS", &jws, (ftnlen)3);
82 swdopn_();
83 /* / GET RANGE OF WORKSTATION RECTANGLE AND SCALING FACTOR / */
84 swqrct_(&wsxmn, &wsxmx, &wsymn, &wsymx, &fact);
85 /* / SET WORKSTATION RECTANGLE / */
86 if (iwsx >= 0) {
87 wx0 = wsxmx - wsxmn;
88 wy0 = wsymx - wsymn;
89 itr = 1;
90 } else {
91 wx0 = wsymx - wsymn;
92 wy0 = wsxmx - wsxmn;
93 itr = 2;
94 }
95 stswrc_(&wsxmn, &wsxmx, &wsymn, &wsymx);
96 swsrot_(&itr);
97 /* / INITIALIZATION FOR LAYOUT / */
98 slinit_(&wx0, &wy0, &fact);
99 /* / SET DUMMY TRANSFORMATION / */
100 /* Computing MIN */
101 r__1 = 1.f, r__2 = wx0 / wy0;
102 rxm = min(r__1,r__2);
103 /* Computing MIN */
104 r__1 = wy0 / wx0;
105 rym = min(r__1,1.f);
106 stswtr_(&c_b9, &rxm, &c_b9, &rym, &c_b9, &wx0, &c_b9, &wy0, &itr);
107 sgsvpt_(&c_b9, &rxm, &c_b9, &rym);
108 sgswnd_(&c_b9, &c_b16, &c_b9, &c_b16);
109 sgstrn_(&c__1);
110 sgstrf_();
111 return 0;
112 /* ----------------------------------------------------------------------- */
113
114 L_sgfrm:
115 /* / INQUIRE LAYOUT STATUS / */
116 sgiget_("NLEVEL", &lev, (ftnlen)6);
117 sgiget_("NFRAME", &ifr, (ftnlen)6);
118 sgiget_("NPAGE", &ipg, (ftnlen)5);
119 /* / SET NEW FRAME / */
120 ++ifr;
121 jfr = ifr;
122 sgiset_("NFRAME", &ifr, (ftnlen)6);
123 /* / INQUIRE PAGE NO. / */
124 slpage_(&lev, &jfr, &ipage);
125 lpage = ipage != ipg;
126 if (lpage) {
127 /* / CLOSE PAGE / */
128 if (lfirst) {
129 lfirst = FALSE_;
130 } else {
131 swpcls_();
132 }
133 /* / NEXT PAGE / */
134 sgiset_("NPAGE", &ipage, (ftnlen)5);
135 swpopn_();
136 /* / PLOT CORNER MARKS & TITLES / */
137 slqrct_(&c__1, &c__1, &xamin, &xamax, &yamin, &yamax);
138 wxl = xamax - xamin;
139 wyl = yamax - yamin;
140 /* Computing MIN */
141 r__1 = 1.f, r__2 = wxl / wyl;
142 rxm = min(r__1,r__2);
143 /* Computing MIN */
144 r__1 = wyl / wxl;
145 rym = min(r__1,1.f);
146 stswtr_(&c_b9, &rxm, &c_b9, &rym, &xamin, &xamax, &yamin, &yamax, &
147 itr);
148 slpcnr_();
149 slpttl_();
150 }
151 /* / GET WORKSTATION RECTANGLE / */
152 slqrct_(&lev, &ifr, &xamin, &xamax, &yamin, &yamax);
153 wxl = xamax - xamin;
154 wyl = yamax - yamin;
155 /* / SET WORKSTATION TRANSFORMATION / */
156 sglget_("LFULL", &lfull, (ftnlen)5);
157 if (lfull) {
158 /* Computing MIN */
159 r__1 = 1.f, r__2 = wxl / wyl;
160 rxm = min(r__1,r__2);
161 /* Computing MIN */
162 r__1 = wyl / wxl;
163 rym = min(r__1,1.f);
164 stswtr_(&c_b9, &rxm, &c_b9, &rym, &xamin, &xamax, &yamin, &yamax, &
165 itr);
166 } else {
167 stswtr_(&c_b9, &c_b16, &c_b9, &c_b16, &xamin, &xamax, &yamin, &yamax,
168 &itr);
169 }
170 /* / SET NORMALIZATION TRANSFORMATION / */
171 stqwtr_(&rxmin, &rxmax, &rymin, &rymax, &wxmin, &wxmax, &wymin, &wymax, &
172 jtr);
173 sgsvpt_(&rxmin, &rxmax, &rymin, &rymax);
174 sgswnd_(&rxmin, &rxmax, &rymin, &rymax);
175 sgstrn_(&c__1);
176 sgstrf_();
177 return 0;
178 /* ----------------------------------------------------------------------- */
179
180 L_sgcls:
181 /* / CLOSE SGKS / */
182 swpcls_();
183 swdcls_();
184 return 0;
185 } /* sgopn_ */
186
sgopn_(integer * iws)187 /* Subroutine */ int sgopn_(integer *iws)
188 {
189 return sgopn_0_(0, iws);
190 }
191
sginit_(void)192 /* Subroutine */ int sginit_(void)
193 {
194 return sgopn_0_(1, (integer *)0);
195 }
196
sgfrm_(void)197 /* Subroutine */ int sgfrm_(void)
198 {
199 return sgopn_0_(2, (integer *)0);
200 }
201
sgcls_(void)202 /* Subroutine */ int sgcls_(void)
203 {
204 return sgopn_0_(3, (integer *)0);
205 }
206
207