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 logical c_false = FALSE_;
18
19 /* ----------------------------------------------------------------------- */
20 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
21 /* ----------------------------------------------------------------------- */
scstrf_(void)22 /* Subroutine */ int scstrf_(void)
23 {
24 /* System generated locals */
25 real r__1;
26
27 /* Builtin functions */
28 double r_lg10(real *);
29
30 /* Local variables */
31 static real cx, cy, cz, vx0, vy0, vz0, fac;
32 static integer itr3;
33 static logical ldeg, lxlog, lylog, lzlog;
34 static real uxmin, vxmin, vymin, vxmax, vymax, vzmin, vzmax, uxmax, uymin,
35 uymax, uzmin, uzmax;
36 extern /* Subroutine */ int stslg3_(logical *, logical *, logical *),
37 stsrd3_(logical *, logical *, logical *), ststr3_(integer *, real
38 *, real *, real *, real *, real *, real *), sgiget_(char *,
39 integer *, ftnlen), sglget_(char *, logical *, ftnlen), msgdmp_(
40 char *, char *, char *, ftnlen, ftnlen, ftnlen), scqlog_(logical *
41 , logical *, logical *), sgrget_(char *, real *, ftnlen), scqwnd_(
42 real *, real *, real *, real *, real *, real *), scqvpt_(real *,
43 real *, real *, real *, real *, real *);
44
45 sgiget_("ITR3", &itr3, (ftnlen)4);
46 sglget_("LDEG", &ldeg, (ftnlen)4);
47 scqlog_(&lxlog, &lylog, &lzlog);
48 if (itr3 == 1) {
49 /* / LINEAR AND LOG / */
50 scqvpt_(&vxmin, &vxmax, &vymin, &vymax, &vzmin, &vzmax);
51 if (! (vxmin < vxmax && vymin < vymax && vzmin < vzmax)) {
52 msgdmp_("E", "SCSTRF", "VIEWPORT DEFINITION IS INVALID.", (ftnlen)
53 1, (ftnlen)6, (ftnlen)31);
54 }
55 scqwnd_(&uxmin, &uxmax, &uymin, &uymax, &uzmin, &uzmax);
56 if (! lxlog) {
57 cx = (vxmax - vxmin) / (uxmax - uxmin);
58 vx0 = vxmin - cx * uxmin;
59 } else {
60 if (uxmin * uxmax <= 0.f) {
61 msgdmp_("E", "SCSTRF", "THE REGION STRADDLES 0 FOR LOG TRANS"
62 "FORMATION (X).", (ftnlen)1, (ftnlen)6, (ftnlen)50);
63 }
64 r__1 = uxmax / uxmin;
65 cx = (vxmax - vxmin) / r_lg10(&r__1);
66 r__1 = abs(uxmin);
67 vx0 = vxmin - cx * r_lg10(&r__1);
68 }
69 if (! lylog) {
70 cy = (vymax - vymin) / (uymax - uymin);
71 vy0 = vymin - cy * uymin;
72 } else {
73 if (uymin * uymax <= 0.f) {
74 msgdmp_("E", "SCSTRF", "THE REGION STRADDLES 0 FOR LOG TRANS"
75 "FORMATION (Y).", (ftnlen)1, (ftnlen)6, (ftnlen)50);
76 }
77 r__1 = uymax / uymin;
78 cy = (vymax - vymin) / r_lg10(&r__1);
79 r__1 = abs(uymin);
80 vy0 = vymin - cy * r_lg10(&r__1);
81 }
82 if (! lzlog) {
83 cz = (vzmax - vzmin) / (uzmax - uzmin);
84 vz0 = vzmin - cz * uzmin;
85 } else {
86 if (uzmin * uzmax <= 0.f) {
87 msgdmp_("E", "SCSTRF", "THE REGION STRADDLES 0 FOR LOG TRANS"
88 "FORMATION (Z).", (ftnlen)1, (ftnlen)6, (ftnlen)50);
89 }
90 r__1 = uzmax / uzmin;
91 cz = (vzmax - vzmin) / r_lg10(&r__1);
92 r__1 = abs(uzmin);
93 vz0 = vzmin - cz * r_lg10(&r__1);
94 }
95 ststr3_(&itr3, &cx, &cy, &cz, &vx0, &vy0, &vz0);
96 stslg3_(&lxlog, &lylog, &lzlog);
97 stsrd3_(&c_false, &c_false, &c_false);
98 } else if (itr3 == 2) {
99 /* / CYLINDRICAL / */
100 sgrget_("SIMFAC3", &fac, (ftnlen)7);
101 sgrget_("VXORG3", &vx0, (ftnlen)6);
102 sgrget_("VYORG3", &vy0, (ftnlen)6);
103 sgrget_("VZORG3", &vz0, (ftnlen)6);
104 ststr3_(&itr3, &fac, &fac, &fac, &vx0, &vy0, &vz0);
105 stslg3_(&c_false, &c_false, &c_false);
106 stsrd3_(&c_false, &ldeg, &c_false);
107 } else if (itr3 == 3) {
108 /* / SPHERICAL / */
109 sgrget_("SIMFAC3", &fac, (ftnlen)7);
110 sgrget_("VXORG3", &vx0, (ftnlen)6);
111 sgrget_("VYORG3", &vy0, (ftnlen)6);
112 sgrget_("VZORG3", &vz0, (ftnlen)6);
113 ststr3_(&itr3, &fac, &fac, &fac, &vx0, &vy0, &vz0);
114 stslg3_(&c_false, &c_false, &c_false);
115 stsrd3_(&c_false, &ldeg, &ldeg);
116 } else {
117 msgdmp_("E", "SCSTRF", "TRANSFORMATION FUNCTION NUMBER IS INVALID.", (
118 ftnlen)1, (ftnlen)6, (ftnlen)42);
119 }
120 return 0;
121 } /* scstrf_ */
122
123