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__0 = 0;
18 static real c_b17 = 0.f;
19
20 /* ----------------------------------------------------------------------- */
21 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
22 /* ----------------------------------------------------------------------- */
scsprj_(void)23 /* Subroutine */ int scsprj_(void)
24 {
25 /* System generated locals */
26 real r__1, r__2, r__3;
27
28 /* Builtin functions */
29 double sqrt(doublereal), atan2(doublereal, doublereal), sin(doublereal);
30
31 /* Local variables */
32 static real x0, y0, cp, rr, rz, fac, the, phi, psi, sec3;
33 static integer ixc3, iyc3, itr3;
34 static logical ldeg;
35 extern real rfpi_(void);
36 static real xobj, yobj, zobj, xoff, yoff, xeye, yeye, zeye, tilt, angle;
37 static integer iwtrf;
38 static real rxmin, rymin, rxmax, rymax, wxmin, wymin, wxmax, wymax;
39 extern /* Subroutine */ int stspr2_(integer *, integer *, real *),
40 stspr3_(real *, real *, real *, real *, real *, real *, real *,
41 real *, real *, real *), scqobj_(real *, real *, real *), sgiget_(
42 char *, integer *, ftnlen), sglget_(char *, logical *, ftnlen),
43 msgdmp_(char *, char *, char *, ftnlen, ftnlen, ftnlen), scqeye_(
44 real *, real *, real *), sgrget_(char *, real *, ftnlen);
45 static logical lprjct;
46 extern /* Subroutine */ int stqwtr_(real *, real *, real *, real *, real *
47 , real *, real *, real *, integer *);
48
49 scqobj_(&xobj, &yobj, &zobj);
50 scqeye_(&xeye, &yeye, &zeye);
51 sgiget_("ITR3", &itr3, (ftnlen)4);
52 sgrget_("XOFF3", &xoff, (ftnlen)5);
53 sgrget_("YOFF3", &yoff, (ftnlen)5);
54 sgrget_("TILT3", &tilt, (ftnlen)5);
55 sgrget_("ANGLE3", &angle, (ftnlen)6);
56 sglget_("LDEG", &ldeg, (ftnlen)4);
57 if (ldeg) {
58 cp = rfpi_() / 180;
59 } else {
60 cp = 1.f;
61 }
62 /* Computing 2nd power */
63 r__1 = xeye - xobj;
64 /* Computing 2nd power */
65 r__2 = yeye - yobj;
66 rz = sqrt(r__1 * r__1 + r__2 * r__2);
67 /* Computing 2nd power */
68 r__1 = xeye - xobj;
69 /* Computing 2nd power */
70 r__2 = yeye - yobj;
71 /* Computing 2nd power */
72 r__3 = zeye - zobj;
73 rr = sqrt(r__1 * r__1 + r__2 * r__2 + r__3 * r__3);
74 the = atan2(rz, zeye - zobj);
75 phi = atan2(yeye - yobj, xeye - xobj);
76 psi = rfpi_() / 2 - cp * tilt;
77 stqwtr_(&rxmin, &rxmax, &rymin, &rymax, &wxmin, &wxmax, &wymin, &wymax, &
78 iwtrf);
79 x0 = (rxmin + rxmax) / 2 + xoff;
80 y0 = (rymin + rymax) / 2 + yoff;
81 if (angle == 0.f) {
82 msgdmp_("E", "SCSPRJ", "ANGLE MUST NOT BE ZERO.", (ftnlen)1, (ftnlen)
83 6, (ftnlen)23);
84 } else {
85 fac = (r__1 = .5f / (rr * sin(cp * angle / 2.f)), abs(r__1));
86 }
87 if (angle <= 0.f) {
88 rr = -rr;
89 }
90 stspr3_(&xobj, &yobj, &zobj, &the, &phi, &psi, &fac, &rr, &x0, &y0);
91 /* / 2-D PROJECTION / */
92 sglget_("L2TO3", &lprjct, (ftnlen)5);
93 if (lprjct) {
94 sgiget_("IXC3", &ixc3, (ftnlen)4);
95 sgiget_("IYC3", &iyc3, (ftnlen)4);
96 sgrget_("SEC3", &sec3, (ftnlen)4);
97 stspr2_(&ixc3, &iyc3, &sec3);
98 } else {
99 stspr2_(&c__0, &c__0, &c_b17);
100 }
101 return 0;
102 } /* scsprj_ */
103
104