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 /* INTERPOLATION FROM GRID POINTS TO GAUSSIAN LATITUDES */
17 /* ********************************************************************** */
18 /* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
19 /* ----------------------------------------------------------------------- */
shly2x_(integer * jm,integer * m,integer * isw,real * wm,real * wx,real * wy,real * z__)20 /* Subroutine */ int shly2x_(integer *jm, integer *m, integer *isw, real *wm,
21 real *wx, real *wy, real *z__)
22 {
23 /* System generated locals */
24 integer wm_offset, wy_dim1, wy_offset, wx_dim1, wx_offset, z_dim1, z_dim2,
25 z_offset, i__1, i__2;
26
27 /* Local variables */
28 static integer j, j1, j2, iswa;
29 static doublereal suma, sums;
30
31 /* ISW=-1: X-DIFFERENTIAL, ISW=0: NORMAL, ISW=1: Y-DIFFERENTIAL */
32 /* Parameter adjustments */
33 z_dim1 = *jm;
34 z_dim2 = *jm - 0 + 1;
35 z_offset = 1 + z_dim1 * (0 + z_dim2);
36 z__ -= z_offset;
37 wy_dim1 = *jm - 0 + 1;
38 wy_offset = 0 + wy_dim1;
39 wy -= wy_offset;
40 wx_dim1 = *jm - 0 + 1;
41 wx_offset = 0 + wx_dim1;
42 wx -= wx_offset;
43 wm_offset = -(*jm);
44 wm -= wm_offset;
45
46 /* Function Body */
47 iswa = abs(*isw);
48 wy[wy_dim1] = wm[0];
49 wy[wy_dim1 * 2] = 0.f;
50 i__1 = *jm;
51 for (j = 1; j <= i__1; ++j) {
52 wy[j + wy_dim1] = (wm[j] + wm[-j]) * .5f;
53 wy[j + (wy_dim1 << 1)] = (wm[j] - wm[-j]) * .5f;
54 /* L10: */
55 }
56 if ((*m + iswa) % 2 == 0) {
57 wx[wx_dim1] = wy[wy_dim1];
58 wx[wx_dim1 * 2] = wy[wy_dim1 * 2];
59 i__1 = *jm;
60 for (j1 = 1; j1 <= i__1; ++j1) {
61 sums = 0.;
62 suma = 0.;
63 i__2 = *jm;
64 for (j2 = 0; j2 <= i__2; ++j2) {
65 sums += z__[j1 + (j2 + z_dim2) * z_dim1] * wy[j2 + wy_dim1];
66 suma += z__[j1 + (j2 + (z_dim2 << 1)) * z_dim1] * wy[j2 + (
67 wy_dim1 << 1)];
68 /* L20: */
69 }
70 wx[j1 + wx_dim1] = sums;
71 wx[j1 + (wx_dim1 << 1)] = suma;
72 /* L30: */
73 }
74 } else {
75 wx[wx_dim1] = wy[wy_dim1];
76 wx[wx_dim1 * 2] = wy[wy_dim1 * 2];
77 i__1 = *jm;
78 for (j1 = 1; j1 <= i__1; ++j1) {
79 sums = 0.;
80 suma = 0.;
81 i__2 = *jm - 1;
82 for (j2 = 0; j2 <= i__2; ++j2) {
83 sums += z__[j1 + (j2 + z_dim2 * 3) * z_dim1] * wy[j2 +
84 wy_dim1];
85 suma += z__[j1 + (j2 + (z_dim2 << 2)) * z_dim1] * wy[j2 + (
86 wy_dim1 << 1)];
87 /* L40: */
88 }
89 wx[j1 + wx_dim1] = sums;
90 wx[j1 + (wx_dim1 << 1)] = suma;
91 /* L50: */
92 }
93 }
94 return 0;
95 } /* shly2x_ */
96
97