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 /* ----------------------------------------------------------------------- */
16 /* MAP PROJECTION (MOLLWEIDE) 93/02/20 S.SAKAI */
17 /* ----------------------------------------------------------------------- */
18 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
19 /* ----------------------------------------------------------------------- */
mpfmwd_0_(int n__,real * xlon,real * ylat,real * x,real * y)20 /* Subroutine */ int mpfmwd_0_(int n__, real *xlon, real *ylat, real *x, real
21 *y)
22 {
23 /* Builtin functions */
24 double cos(doublereal), sin(doublereal), asin(doublereal);
25
26 /* Local variables */
27 static real pi, rna;
28 extern real rfpi_(void);
29 static real alpha;
30 extern /* Subroutine */ int glrget_(char *, real *, ftnlen);
31 extern real xmplon_(real *);
32 extern /* Subroutine */ int mpzmwd_();
33 extern /* Subroutine */ int mpznwt_(U_fp, real *, real *);
34
35 switch(n__) {
36 case 1: goto L_mpimwd;
37 }
38
39 pi = rfpi_();
40 alpha = *ylat;
41 mpznwt_((U_fp)mpzmwd_, ylat, &alpha);
42 *x = xmplon_(xlon) * 2.8284272000000001f * cos(alpha) / pi;
43 *y = sin(alpha) * 1.4142136f;
44 return 0;
45 /* ----------------------------------------------------------------------- */
46
47 L_mpimwd:
48 pi = rfpi_();
49 if (abs(*y) < 1.4142136f) {
50 alpha = asin(*y / 1.4142136f);
51 *xlon = *x / 1.4142136f / cos(alpha) * pi / 2;
52 if (abs(*xlon) <= pi) {
53 *ylat = asin((alpha * 2 + sin(alpha * 2)) / pi);
54 return 0;
55 }
56 } else if (abs(*y) == 1.4142136f && *x == 0.f) {
57 *xlon = 0.f;
58 *ylat = *y / 1.4142136f / 2 * pi;
59 return 0;
60 }
61 glrget_("RUNDEF", &rna, (ftnlen)6);
62 *xlon = rna;
63 *ylat = rna;
64 return 0;
65 } /* mpfmwd_ */
66
mpfmwd_(real * xlon,real * ylat,real * x,real * y)67 /* Subroutine */ int mpfmwd_(real *xlon, real *ylat, real *x, real *y)
68 {
69 return mpfmwd_0_(0, xlon, ylat, x, y);
70 }
71
mpimwd_(real * x,real * y,real * xlon,real * ylat)72 /* Subroutine */ int mpimwd_(real *x, real *y, real *xlon, real *ylat)
73 {
74 return mpfmwd_0_(1, xlon, ylat, x, y);
75 }
76
77