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__1 = 1;
18
19 /* ----------------------------------------------------------------------- */
20 /* USPACK SET PARAMETER */
21 /* ----------------------------------------------------------------------- */
22 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
23 /* ----------------------------------------------------------------------- */
uspfit_(void)24 /* Subroutine */ int uspfit_(void)
25 {
26 /* Builtin functions */
27 integer i_indx(char *, char *, ftnlen, ftnlen);
28
29 /* Local variables */
30 static real dt, cw, rmc;
31 static integer itr;
32 static real xfac, yfac;
33 static logical loff;
34 static real xoff, yoff, xmin, ymin, xmax, ymax;
35 static integer itrw;
36 static real rmrgn;
37 static logical lxinv, lyinv;
38 static real vxmin, vxmax, vymin, vymax, wxmin, wxmax, wymin, wymax, uxmax,
39 uxmin, uymax, uymin, vxmin0, vymin0, vxmax0, vymax0;
40 static char cxside[2], cyside[2];
41 extern /* Subroutine */ int sgiget_(char *, integer *, ftnlen);
42 static real rundef;
43 extern /* Subroutine */ int glrget_(char *, real *, ftnlen), msgdmp_(char
44 *, char *, char *, ftnlen, ftnlen, ftnlen), uscget_(char *, char *
45 , ftnlen, ftnlen), sgrget_(char *, real *, ftnlen), cupper_(char *
46 , ftnlen), uslget_(char *, logical *, ftnlen), sgswnd_(real *,
47 real *, real *, real *), usrget_(char *, real *, ftnlen), uzlget_(
48 char *, logical *, ftnlen), usurdl_(real *, real *, real *, real *
49 ), uzrget_(char *, real *, ftnlen), sgstrn_(integer *), usurdt_(
50 real *, real *, real *, real *, real *), sgsvpt_(real *, real *,
51 real *, real *), uswapz_(real *, real *, integer *);
52 static real uxuser;
53 extern /* Subroutine */ int usspnt_(integer *, real *, real *);
54 static real uyuser;
55 extern /* Subroutine */ int stqwtr_(real *, real *, real *, real *, real *
56 , real *, real *, real *, integer *);
57
58 glrget_("RUNDEF", &rundef, (ftnlen)6);
59 uscget_("CXSIDE", cxside, (ftnlen)6, (ftnlen)2);
60 uscget_("CYSIDE", cyside, (ftnlen)6, (ftnlen)2);
61 cupper_(cxside, (ftnlen)2);
62 cupper_(cyside, (ftnlen)2);
63 if (i_indx(cyside, "U", (ftnlen)2, (ftnlen)1) != 0) {
64 uzrget_("UXUSER", &uxuser, (ftnlen)6);
65 usspnt_(&c__1, &uxuser, &rundef);
66 }
67 if (i_indx(cxside, "U", (ftnlen)2, (ftnlen)1) != 0) {
68 uzrget_("UYUSER", &uyuser, (ftnlen)6);
69 usspnt_(&c__1, &rundef, &uyuser);
70 }
71 sgiget_("ITR", &itr, (ftnlen)3);
72 uslget_("LXINV", &lxinv, (ftnlen)5);
73 uslget_("LYINV", &lyinv, (ftnlen)5);
74 uzlget_("LOFFSET", &loff, (ftnlen)7);
75 /* --------------------------- VIEW PORT --------------------------------- */
76 sgrget_("VXMIN", &vxmin, (ftnlen)5);
77 sgrget_("VXMAX", &vxmax, (ftnlen)5);
78 sgrget_("VYMIN", &vymin, (ftnlen)5);
79 sgrget_("VYMAX", &vymax, (ftnlen)5);
80 usrget_("RMRGN", &rmrgn, (ftnlen)5);
81 uzrget_("RSIZEL1", &cw, (ftnlen)7);
82 rmc = rmrgn * cw;
83 stqwtr_(&vxmin0, &vxmax0, &vymin0, &vymax0, &wxmin, &wxmax, &wymin, &
84 wymax, &itrw);
85 if (vxmin == rundef) {
86 vxmin = vxmin0 + rmc;
87 }
88 if (vxmax == rundef) {
89 vxmax = vxmax0 - rmc;
90 }
91 if (vymin == rundef) {
92 vymin = vymin0 + rmc;
93 }
94 if (vymax == rundef) {
95 vymax = vymax0 - rmc;
96 }
97 /* ----------------------------- X-AXIS ---------------------------------- */
98 sgrget_("UXMAX", &xmax, (ftnlen)5);
99 sgrget_("UXMIN", &xmin, (ftnlen)5);
100 if (xmin != rundef && xmax != rundef && xmin > xmax) {
101 lxinv = TRUE_;
102 uswapz_(&xmin, &xmax, &c__1);
103 }
104 usrget_("XDTMAX", &uxmax, (ftnlen)6);
105 usrget_("XDTMIN", &uxmin, (ftnlen)6);
106 if (xmin != rundef) {
107 uxmin = xmin;
108 }
109 if (xmax != rundef) {
110 uxmax = xmax;
111 }
112 if (uxmin == rundef || uxmax == rundef) {
113 msgdmp_("E", "USPFIT", "XMIN OR XMAX IS NOT DEFINED.", (ftnlen)1, (
114 ftnlen)6, (ftnlen)28);
115 }
116 if (loff) {
117 uzrget_("XOFFSET", &xoff, (ftnlen)7);
118 uzrget_("XFACT", &xfac, (ftnlen)5);
119 uxmin = xfac * uxmin + xoff;
120 uxmax = xfac * uxmax + xoff;
121 }
122 if (itr == 1 || itr == 2) {
123 usurdt_(&uxmin, &uxmax, &vxmin, &vxmax, &dt);
124 } else if ((real) itr == 3.f || itr == 4) {
125 usurdl_(&uxmin, &uxmax, &vxmin, &vxmax);
126 } else {
127 msgdmp_("E", "USPFIT", "INVALID ITR", (ftnlen)1, (ftnlen)6, (ftnlen)
128 11);
129 }
130 if (xmin != rundef) {
131 uxmin = xmin;
132 }
133 if (xmax != rundef) {
134 uxmax = xmax;
135 }
136 /* ----------------------------- Y-AXIS ---------------------------------- */
137 sgrget_("UYMAX", &ymax, (ftnlen)5);
138 sgrget_("UYMIN", &ymin, (ftnlen)5);
139 if (ymin != rundef && ymax != rundef && ymin > ymax) {
140 lyinv = TRUE_;
141 uswapz_(&ymin, &ymax, &c__1);
142 }
143 usrget_("YDTMAX", &uymax, (ftnlen)6);
144 usrget_("YDTMIN", &uymin, (ftnlen)6);
145 if (ymin != rundef) {
146 uymin = ymin;
147 }
148 if (ymax != rundef) {
149 uymax = ymax;
150 }
151 if (uymin == rundef || uymax == rundef) {
152 msgdmp_("E", "USPFIT", "YMIN OR YMAX IS NOT DEFINED.", (ftnlen)1, (
153 ftnlen)6, (ftnlen)28);
154 }
155 if (loff) {
156 uzrget_("YOFFSET", &yoff, (ftnlen)7);
157 uzrget_("YFACT", &yfac, (ftnlen)5);
158 uymin = yfac * uymin + yoff;
159 uymax = yfac * uymax + yoff;
160 }
161 if (itr == 1 || itr == 3) {
162 usurdt_(&uymin, &uymax, &vymin, &vymax, &dt);
163 } else {
164 usurdl_(&uymin, &uymax, &vymin, &vymax);
165 }
166 if (ymin != rundef) {
167 uymin = ymin;
168 }
169 if (ymax != rundef) {
170 uymax = ymax;
171 }
172 /* ----------------------------------------------------------------------- */
173 if (lxinv) {
174 uswapz_(&uxmin, &uxmax, &c__1);
175 }
176 if (lyinv) {
177 uswapz_(&uymin, &uymax, &c__1);
178 }
179 sgswnd_(&uxmin, &uxmax, &uymin, &uymax);
180 sgsvpt_(&vxmin, &vxmax, &vymin, &vymax);
181 sgstrn_(&itr);
182 return 0;
183 } /* uspfit_ */
184
185