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 /* Common Block Declarations */
16
17 struct {
18 integer itr;
19 real rundef;
20 integer iundef;
21 real pi, cpr, cpd, cp;
22 } umwk1_;
23
24 #define umwk1_1 umwk1_
25
26 /* Table of constant values */
27
28 static real c_b10 = 0.f;
29
30 /* ----------------------------------------------------------------------- */
31 /* UMSPCW : CIRCLE WINDOW */
32 /* ----------------------------------------------------------------------- */
33 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
34 /* ----------------------------------------------------------------------- */
umspcw_(void)35 /* Subroutine */ int umspcw_(void)
36 {
37 /* System generated locals */
38 real r__1, r__2;
39
40 /* Local variables */
41 static real r__, plx, ply, xcntr, ycntr, plrot, stlat1, stlat2;
42 extern /* Subroutine */ int msgdmp_(char *, char *, char *, ftnlen,
43 ftnlen, ftnlen), sgrget_(char *, real *, ftnlen), umqcwd_(real *,
44 real *, real *), sgqmpl_(real *, real *, real *), sgsmpl_(real *,
45 real *, real *), sgrset_(char *, real *, ftnlen);
46
47 sgqmpl_(&plx, &ply, &plrot);
48 if (plx != umwk1_1.rundef && ply != umwk1_1.rundef && plrot !=
49 umwk1_1.rundef) {
50 return 0;
51 }
52 umqcwd_(&xcntr, &ycntr, &r__);
53 if (xcntr == umwk1_1.rundef || ycntr == umwk1_1.rundef || r__ ==
54 umwk1_1.rundef) {
55 return 0;
56 }
57 if (10 <= umwk1_1.itr && umwk1_1.itr <= 19) {
58 plx = xcntr;
59 ply = umwk1_1.cpd * 90.f;
60 } else if (20 <= umwk1_1.itr && umwk1_1.itr <= 24) {
61 plx = xcntr;
62 ply = umwk1_1.cpd * 90.f;
63 if (ycntr == 0.f) {
64 msgdmp_("E", "UMSPCW", "INVALID WINDOW FOR CONICAL PROJECTION.", (
65 ftnlen)1, (ftnlen)6, (ftnlen)38);
66 }
67 sgrget_("STLAT1", &stlat1, (ftnlen)6);
68 sgrget_("STLAT2", &stlat2, (ftnlen)6);
69 if (umwk1_1.itr == 22) {
70 if (stlat1 == umwk1_1.rundef) {
71 /* Computing MAX */
72 r__1 = ycntr - r__, r__2 = umwk1_1.cpd * -89.f;
73 stlat1 = max(r__1,r__2);
74 }
75 if (stlat2 == umwk1_1.rundef) {
76 /* Computing MIN */
77 r__1 = ycntr + r__, r__2 = umwk1_1.cpd * 89.f;
78 stlat2 = min(r__1,r__2);
79 }
80 sgrset_("STLAT1", &stlat1, (ftnlen)6);
81 sgrset_("STLAT2", &stlat2, (ftnlen)6);
82 } else {
83 if (stlat1 == umwk1_1.rundef) {
84 stlat1 = ycntr;
85 }
86 sgrset_("STLAT1", &stlat1, (ftnlen)6);
87 }
88 } else if (30 <= umwk1_1.itr && umwk1_1.itr <= 34) {
89 plx = xcntr;
90 ply = ycntr;
91 }
92 sgsmpl_(&plx, &ply, &c_b10);
93 return 0;
94 } /* umspcw_ */
95
96